perm filename SCOLB.F4[MUS,LCS]1 blob sn#138836 filedate 1973-08-06 generic text, type T, neo UTF8
00100	C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
00200	C  AT STANFORD UNIVERSITY.  IT MAY NOT BE COPIED OR ALTERED IN ANY
00300	C  WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.
00400	
00500	
00600	C   6/10/72 **********  SCORE  **********  LELAND SMITH, SEP.1969
00700	
00800	C   THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND 
00900	C   GENERATION PROGRAM.
01000	C   IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO' FORMAT.
01100	C   LOAD 'SCORE' WITH BRZ.REL (RAN. NUM GENERATOR),SPRINT.MAC AND,
01200	C   SCANX, (AND QUAD AND QUADO WHEN THEY ARE READY) AND
01300	C   IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
01400	C	SUBROUTINE SUBR
01500	C	COMMON /INS/ INST(27),BG(60)
01600	C	COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF
01700	C   INUM=INST#  IPAR=PARAM#  
01800	C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
01900	C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
02000	C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
02100	C   NOTE #S IN SUBROUTINE: (1-84)  C4=37  FS4=43  C5=49  ETC.
02200	C   F1=86  F15=100 (NO F16!)
02300	
02400		COMMON /Q/ BNW(100),NWZ
02500		COMMON /INS/INST,BG
02600		DIMENSION ROFF(27),V(2000),NP(27),PCH(27,32),INST(27)
02700		1 ,RDEV(27),IPT(27,31),XT(27),BG(60),OTH(20,16),SCAL(101)
02800		1 ,IV(2000),NCNT(27,32),P1(27),IT(30),JFM(4)
02900		1 ,IOUT(70),IFM(80),COPY(30),LIST(78),JPT(837)
03000		1 ,FINM(6),TINST(5),TPALN(4),ENFI(5),TEDIT(4),INVIS(27)
03100	C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
03200	C   40 LIT CHARS + 30 PARAMS PER INST.
03300	C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
03400		COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
03500		1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
03600		1 ,INP(72),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
03700		EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),
03800		1 (VX1,VX(1)),(INP1,INP(1)),(PL4,PL(4)),(IPP,ISCA(2))
03900		1 ,(IEN,ISCA(4)),(IPT,JPT),(ISS,ISCA(9)),(ITT,ISCA(11))
04000		1 ,(IE,ISCA(5)),(ID,ISCA(3)),(IF,ISCA(6)),(IAA,ISCA(10))
04100		1 ,(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH),(VX4,VX(4))
04200		1 ,(VX5,VX(5)),(IDOT,IDAT(11)),(VX,IOUT),(IFM3,IFM(3))
04300		1 ,(IT,INP(27)),(V,IV),(PLAY,ISCA(7)),(IFM2,IFM(2))
04400		1 ,(IFM4,IFM(4)),(IFM(3),LIST)
04500		DATA KZY/27/,ISEMI/';'/,RTF/.05/,IQT/'"'/
04600		1, JFM(3)/','/
04700	C  IAA=A  ID=D  IE=E  IF=F  IEN=N  IPP=P  ISS=S  ITT=T
04800		DATA KSLA/'/'/,IBLA/' '/,BLA/' '/,IXX/'X'/,ITMPO/'TEMPO'/
04900		1 ,ISCA/'C','P','D','N','E','F','PLAY;','G','S','A','T','B'/
05000		1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
05100		1 ,SCAL/'C/8','CS/8','D/8','DS/8','E/8','F/8','FS/8','G/8',
05200		1 'GS/8','A/8','AS/8','B/8','C/4','CS/4','D/4','DS/4','E/4',
05300		1 'F/4','FS/4','G/4','GS/4','A/4','AS/4','B/4','C/2','CS/2',
05400		1 'D/2','DS/2','E/2','F/2','FS/2','G/2','GS/2','A/2','AS/2',
05500		1 'B/2','C','CS','D','DS','E','F','FS','G','GS','A','AS',
05600		1 'B','C*2','CS*2','D*2','DS*2','E*2','F*2','FS*2','G*2',
05700		1 'GS*2','A*2','AS*2','B*2','C*4','CS*4','D*4','DS*4','E*4',
05800		1 'F*4','FS*4','G*4','GS*4','A*4','AS*4','B*4','C*8','CS*8',
05900		1 'D*8','DS*8','E*8','F*8','FS*8','G*8','GS*8','A*8','AS*8',
06000		1 'B*8','R','F1','F2','F3','F4','F5','F6','F7','F8','F9',
06100		1 'F10','F11','F12','F13','F14','F15','END'/,I1X/'1X'/
06200		1 ,IFM(1)/'('/,IFM2/'1XA5,'/,IFCOM/5H', ',/,IA1/'A1,'/
06300		LPAR=0
06400		IPRN=0
06500		QX=0.
06600		MOT=0
06700		RETRO=-1.
06800		INVRT=-1
06900		LCNT=1
07000		PARENS=0
07100	      JZ=1  
07200		CALL RNDINT
07300	      PR=0  
07400		IAMP=0
07500	C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
07600	      T5=0  
07700	      NINS=0
07800		K=0
07900		IDALL=-1
08000		QTS=-1.
08100	      KB=0  
08200	      NWZ=1
08300		BNW(1)=0
08400		I=1
08500	      KL=0  
08600	      TP=0  
08700		KN=IBLA
08800	      RA=0  
08900	      CHN=0 
09000		DO 127 K=1,77,3
09100	127	LIST(K)=0
09200	C  INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
09300		NWX=0
09400		BY=-1
09500	      DO 1128 K=1,KZY     
09600		INVIS(K)=0
09700		INST(K)=0
09800		CNT(K)=0
09900		RDEV(K)=0
10000	C  RDEV IS FOR RAND DEVIATIONS AT RUN TIME
10100		NP(K)=0
10200		IQ(K)=0
10300	C   IQ IS FOR RESTART FLAG
10400		IPT(K,1)=0
10500	      DO 1128 L=1,32    
10600	1128   PCH(K,L)=0 
10700	
10800		ITYP=-1
10900	C   TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
11000	C   SECONDS TO BE OMITTED, DUR AT CUTOFF.
11100		JED=-1
11200	2112	TYPE 8002
11300	1112	ACCEPT 77732,INP
11400		JFM(4)='5F)'
11500		JFM(1)='   (A'
11600	C   FOR FREE 'A' FORMAT
11700		CALL FMT(JFM,INP,MLX)
11800		REREAD JFM,K,TF,AMPFAC,OP1,DURX
11900	C  JFM IS THE CURRENT FORMAT STATEMENT
12000		IF(K.NE.'EDIT')GO TO 3112
12100		JED=0
12200		GO TO 2112
12300	C  'E(DIT)' GOES TO EDIT MODE
12400	3112	IF(TF.EQ.0)TF=1.
12500		IF(AMPFAC.EQ.0)AMPFAC=1.
12600	CC**FROM 11700 CHANGED 3/73  IF(TF.NE.999.)GO TO 21122
12700	21122	IF(K.NE.'TYPE')GO TO 128
12800		ITYP=0
12900		DATA FINM/30H(' TYPE OUTPUT FILE NAME'/)   /
13000		TYPE FINM
13100	C  TO USE TYPE-IN MODE.  FILE OF INPUT IS WRITTEN ON FOR21.DAT
13200		ACCEPT 1127,ISLAC
13300		IF(ISLAC.EQ.IBLA)STOP
13400		REWIND 21
13500	CC	WRITE (21,11122) ISLAC
13600		WRITE (21,1127) ISLAC
13700		GO TO 3127
13800	11122	FORMAT(1XA5,72A1)
13900	128	IF(K.NE.'INFO')GO TO 3128
14000		TYPE 8002
14100		TYPE 1113
14200		TYPE 118
14300		TYPE 1114
14400		TYPE 8002
14500		GO TO 1112
14600	118	FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22, PROOF=3, DEBUG=4'/)
14700	8002	FORMAT(' TYPE FILE NAME'/)
14800	8001	FORMAT(A5,5F)
14900	107	FORMAT(I,A5,5F)
15000	1113	FORMAT('     NAME, TF, AMPFAC, OMIT", DUR".'/)
15100	1114	FORMAT(' N1, N2=RAN NUM, N3=0 LISTS INPUT, N4=SINGLE INST.'/
15200		1 ' IF -- N1=3 DURS ONLY, =4 V ARRAY'/
15300		1 3X' 27 INSTRUMENTS ARE AVAILABLE'/)
15400	1127	FORMAT(A5,72A1)
15500	3128	IF(K.NE.IBLA)IFLNM=K
15600		CALL IFILE(1,IFLNM)
15700		READ(1,107)LN,ISLAC
15800		REREAD 77732,INP
15900	C   FOR LATER USE
16000		IF(LN.NE.0)GO TO 3127
16100	C   JUMP IF THE FILE HAS LINE NUMBERS.
16200		REREAD 1127,ISLAC
16300	C   REREADS FIRST LINE
16400	CC	IF(ISLAC.NE.'COMME')GO TO 3127
16500	CC	DO 31271 K=1,72
16600	CC	READ(1,77732),KL,KL
16700	CC31271	IF(KL.EQ.ISEMI)GO TO 3127
16800	C  TO SKIP OVER 'COMMENT' SECTION  OF TVED FILES.
16900	
17000	3127	TYPE 118
17100		IF(DURX.EQ.0)DURX=19999.
17200		IXIN=1
17300	CC -- NOW AT TOP OF PAGE 4(2/74)	DO 1107 K=1,30
17400	CC1107	PL(K)=1.
17500		INONLY=-1
17600		ACCEPT 300,MX,X,Y,Z
17700		IF(Z.NE.0)INONLY=Z
17800		IF(X.NE.0)IXIN=X
17900	C   MX=3 GIVES DURS ONLY
18000	C  TO SUPPRESS LIST OF INPUT DATA, TYPE ANY 3RD NUM. (BUT 9.)
18100	C  (1 1 1 =RECORD,RAN. NUM=1,SUPPRESS INPUT.)
18200		MZ=0
18300		JOUT=5
18400	C  5=OUTPUT TO TTY
18500		SOS=-1.
18600		IF(Y.NE.0)SOS=0  
18700	C  IF 3RD NUM≠0, EDIT FILE WILL PRINT AS IT IS READ.
18800		IF(MX.NE.22)GO TO 2107
18900		JOUT=22
19000		REWIND 22
19100	2107	IF(MX.LE.1)MX=MX-2
19200		IF(MX.EQ.-2.OR.MX.EQ.2.OR.MX.EQ.22)MZ=-1
19300		IF(MX.EQ.4)MZ=-4
19400		IF(SOS.AND.ITYP)WRITE(JOUT,87732)INP
19500	CC	IF(ITYP.EQ.0)GO TO 2308
19600	CC	WRITE(JOUT,77732)INP
19700	
19800	C   *************** READS INPUT  ***********************
19900	2308	IF(ITYP)GO TO 2127
20000		DATA TINST /25H(' TYPE INST NAME, ETC'/)/
20100		1,TEDIT/20H(' RETYPE LINE?'/  )/
20200	23081	TYPE TINST
20300		ACCEPT 77732,INP
20400		IF(JED)WRITE(21,77732)INP
20500		JFM(4)='72A1)'
20600	C  PUTS ON LPT AND TTY
20700	CC	JFM(1)='   (A'
20800	CC	CALL FMT(JFM,INP,MLX)
20900	CC	REREAD JFM,J,INP
21000	CC	WRITE(21,11122) J,INP
21100		GO TO 1074
21200	2127	JREAD=1
21300	4400	READ(1,77732,END=2337)INP
21400		IF(SOS)WRITE(JOUT,87732)INP
21500		GO TO(441,442,443,444,445,446)JREAD
21600	
21700	441	JFM(4)='72A1)'
21800		IF(LN.EQ.0)GO TO 1074
21900		REREAD 2114,LN,INP
22000		JFM(1)=' (I,A'
22100		CALL FMT(JFM,INP,MLX)
22200		REREAD JFM,LN,J,INP
22300		GO TO 4127
22400	1074	JFM(1)='   (A'
22500		CALL FMT(JFM,INP,MLX)
22600		REREAD JFM,J,INP
22700	CC	IF(LN.EQ.0)READ(1,1127,END=2337)J,INP
22800	4127	IF(JED.OR.K.EQ.'Y')GO TO 41271
22900	C  K CHECK IS TO PASS AFTER RETYPING
23000		TYPE TEDIT
23100		ACCEPT 77732,K
23200		IF(K.EQ.'Y')GO TO 23081
23300		IF(K.EQ.'G')JED=-1
23400	
23500	
23600	41271	IF(J.EQ.IBLA)GO TO 2308
23700		MLX=1
23800		IZ=0
23900		JA=-1
24000		ISUB=4
24100		ALL=1.
24200		VX1=0
24300		VX2=0
24400		VX3=0
24500		LK=-1
24600		K=0
24700		IF(V(I-1).NE.-9900.-BY)GO TO 364
24800		BY=-1.
24900		I=I-1
25000	364	DO 361 JD=1,72
25100		N=INP(JD)
25200		IF(N.NE.'R')GO TO 361
25300	C  LOOKS FOR 'RESTART'
25400		DO 3611 M=JD,72
25500		KL=INP(M)
25600		IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI.OR.KL.EQ.KSLA.OR.KL.EQ.',')GO TO 3631
25700	CC	IF(INP(M).EQ.IBLA)GO TO 3631
25800	3611	INP(M)=IBLA
25900	C   CHANGES 'RESTART' TO BLANKS
26000	3631	DO 363 N=1,NINS
26100		IF(J.NE.INST(N))GO TO 363
26200		IQ(N)=-1
26300	C   SETS RESTART FLAG.  THIS INST WILL NOW APPEAR WITH NEW NUM.
26400		GO TO 362
26500	363	CONTINUE
26600	361	IF(N.EQ.KSLA.OR.N.EQ.ISEMI)GO TO 6773
26700	6773	K=K+1
26800		IF(K.GT.NINS)GO TO 36
26900		IF(INST(K).NE.J.OR.IQ(K).EQ.-1)GO TO 6773
27000	C   FINDS CORRECT INST NUM.  PASSES RESTARTED INSTS.
27100		LK=K
27200		GO TO 1773
27300	36	IF(J.EQ.'RUN;'.OR.J.EQ.'RUN')GO TO 2337
27400		IF(J.EQ.'INSER'.OR.J.EQ.'EDIT')ISUB=6  
27500		IF(J.EQ.ITMPO.OR.J.EQ.'CONDU'.OR.J.EQ.'PLAY'.OR.ISUB.GT.4)
27600		1GO TO 1773
27700		IF(J.EQ.'SECTI')GO TO 1081
27800	C******************  ABOVE AND BELOW FOR 'SECTIONS'
27900		IF(J.EQ.'END'.OR.J.EQ.'END S'.OR.J.EQ.'FINIS')GO TO 1082
28000	362	LK=NINS+1
28100		IF(LK.GT.KZY)GO TO 99
28200		INST(LK)=J
28300		IZ=LK
28400		GO TO 1773
28500	
28600	C*********** DOWN TO 99 FOR 'SECTIONS'
28700	1083	V(I)=-99.
28800		KL=1
28900		GO TO 3083
29000	C  READS 'PLAY SECT. N1,N2'
29100	1081	V(I)=-199.
29200		KL=4
29300	3083	DO 2081 K=KL,72
29400		IF(INP(K).EQ.IBLA)GO TO 2081
29500		IV(I+1)=INP(K)
29600		I=I+2
29700	3081	BY=-1.
29800		GO TO 2308
29900	2081	CONTINUE
30000	C   READS SECTION IDENTIFIER, -199. MARKS BEGINNING
30100	C1082	IF(V(I-1).EQ.-9900.-BY)I=I-1
30200	C********* FEB 15,71
30300	1082	V(I)=-299.
30400		I=I+1
30500		GO TO 3081
30600	C   MARKS END OF SECTION
30700	C************************
30800	
30900	99	TYPE 199,LN
31000		STOP
31100	199	FORMAT(' ERROR!!  LAST LINE READ =',I6/)
31200	4	IF(LK.LE.NINS)GO TO 8773
31300		IF(ALL.GT.0)GO TO 1004
31400		IF(IDALL.GT.0)GO TO 8773
31500		BG(LK)=VX1
31600		IDALL=LK
31700		GO TO 2004
31800	C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
31900	1004	BG(LK)=VX1
32000		IF(LK.EQ.IZ)VX1=0
32100	C   MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0.
32200	C   CHECK EFFECT ON 'MOVE'!
32300	C ******** APR.23, 1971  FIXES BG TIMES IN 'MOVE'?????!!!!!!!
32400	2004	NINS=LK
32500		IF(VX3.NE.0)VX2=10000.+VX3
32600		IF(VX2.EQ.0)VX2=-1
32700		DUR(LK)=VX2
32800		GO TO 900
32900	C******** ABOVE FOR REST ONLY ENTRIES.  FEB 18,71
33000	8773	IF(VX2.NE.0)VX1=VX1*10000.+VX2
33100	900	IF(VX1.EQ.BY.AND.J.NE.'PLAY')GO TO 5773
33200	C*********** 'PLAY' IS FOR 'SECTIONS'
33300		BY=VX1
33400	C  BY=CURRENT BG TIME.
33500	C********* FEB 15,71
33600		V(I)=-9900.-BY
33700		I=I+1
33800		IF(NWZ.NE.0)CALL BGSORT(BY)
33900	5773	IF(J.EQ.'TEMPO')GO TO 1106
34000		IF(J.EQ.'CONDU')GO TO 3018
34100		IF(J.EQ.'PLAY')GO TO 1083
34200	C*********** ABOVE FOR 'SECTIONS'
34300	4773	NW=LPAR
34400		IF(I.GT.1900.)TYPE 107,I
34500		ALL=1.
34600		DF=0
34700		ISUB=1
34800	1299	IF(JZ.NE.0)GO TO 1773
34900	
35000	
35100	7773	IF(ITYP)GO TO 77731
35200		DATA TPALN /20H(' TYPE A LINE'/)   /
35300	77734	TYPE TPALN
35400		ACCEPT 77732,INP
35500		IF(JED)WRITE(21,77732) INP
35600		IF(INP1.EQ.IBLA)GO TO 77734
35700		GO TO 77733
35800	77732	FORMAT(72A1)
35900	87732	FORMAT(1X72A1)
36000	77731	JREAD=2
36100		GO TO 4400
36200	442	IF(LN.NE.0)REREAD 2114,LN,INP
36300		IF(INP1.EQ.IBLA)GO TO 77731
36400		IF(JED)GO TO 77733
36500		TYPE TEDIT
36600		ACCEPT 77732,K
36700		IF(K.EQ.'Y')GO TO 77734
36800		IF(K.EQ.'G')JED=-1
36900	C   DOESN'T WORK FOR EDITS AND INSERTS YET???
37000	CC	IF(SOS)WRITE(JOUT,2114),LN,INP
37100	
37200	
37300	77733	MLX=1
37400	C   'LISTS' MUST END WITH * 
37500	CC1773	JZ=0
37600	1773	IF(IPRN.EQ.0)GO TO 17732
37700		L=I-1
37800		IF(QTS.AND.V(I-1).EQ.999.)L=L-1
37900		IPRN=IPRN-1
38000		IF(PARENS.EQ.0)GO TO 17733
38100		PARENS=0
38200		LIST(LCNT+2)=L
38300		LCNT=LCNT+3
38400		IF(IPRN.EQ.0)GO TO 17732
38500		IPRN=0
38600	17733	LIST(MOT)=L
38700		MOT=0
38800	C   FOR ERROR TRAP
38900	
39000	17732	JZ=0
39100		N=0
39200	17731	ML=MLX
39300	
39400	C   BIG LOOP -- TO END OF PAGE 1.
39500		JD=ML
39600	975	N=INP(JD)
39700		IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 236
39800	C ((((())))) MAY 13,71 /Z (D4/E/X 2 3)/ CS/ ETC.  CAN USE 26 LABELS.
39900	33611	IF(N.NE.'('.AND.N.NE.')')GO TO 2361
40000		INP(JD)=IBLA
40100		L=JD-1
40200	5113	IF(INP(L).NE.IBLA)GO TO 2113
40300		L=L-1
40400		GO TO 5113
40500	2113	IF(N.EQ.')')GO TO 3361
40600		IF(PARENS.EQ.0)GO TO 1140
40700		LCNT=LCNT+3
40800		IF(MOT.NE.0)GO TO 11403
40900		MOT=LCNT-1
41000	1140	DO 11401 JC=1,LCNT-1,3
41100		IF(INP(L).NE.LIST(JC))GO TO 11401
41200	C  FINDS DUPLICATE IDENTIFIER
41300		TYPE 11402,INP(L)
41400		GO TO 99
41500	11403	TYPE 11404
41600		GO TO 99
41700	11404	FORMAT(' MORE THAN 2 PARENS OPEN'/)
41800	
41900	11402	FORMAT(' MOTIVIC (',A1,') USED TWICE')
42000	11401	CONTINUE
42100		LIST(LCNT)=INP(L)
42200		PARENS=-1.
42300		INP(L)=IBLA
42400		LIST(LCNT+1)=I
42500		GO TO 236
42600	CC33612	IF(QTS)GO TO 236
42700	CC	GO TO 6721
42800	C ''''''' FOR SINGLE QUOTES
42900	3361	IPRN=IPRN+1
43000	CC	IF(QTS)GO TO 236
43100	CC	GO TO 7231
43200		GO TO 236
43300	C  JUMPS BACK INTO QUOTE SECTION
43400	CQ	IF(PARENS.EQ.0)GO TO 2140
43500	CQ	LIST(LCNT+2)=L
43600	CQ	LCNT=LCNT+3
43700	CQ	PARENS=0
43800	CQ	GO TO 33612
43900	CQ2140	LIST(MOT)=L
44000	CQ	GO TO 33612
44100	CQC )))))))))))  LAST ) CAN'T APPEAR AT END OF LINE!!
44200	C @@@@@@@@@@@@ /@Z/DS3/ ETC. 
44300	2361	IF(N.NE.'@')GO TO 5361
44400		DO 113 L=1,72
44500		K=JD+L
44600	C   K IS USED AT 240!!!
44700		JG=INP(K)
44800		IF(JG.NE.'-')GO TO 6113
44900		RETRO=0
45000		INP(K)=IBLA
45100		GO TO 113
45200	6113	IF(JG.NE.'$')GO TO 7113
45300	C  '$' IS FOR INVERSIONS IN 'NOTES'
45400		INVRT=0
45500		GO TO 113
45600	7113	IF(JG.NE.IBLA)GO TO 4113
45700	113	CONTINUE
45800	4113	DO 6361 L=1,LCNT,3
45900		IF(JG.NE.LIST(L))GO TO 6361
46000		VX1=0
46100		DO 40 M=JD+2,72
46200		JG=INP(M)
46300		IF(JG.EQ.IBLA)GO TO 40
46400		IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.'*')GO TO 140
46500		ML=M
46600		GO TO 240
46700	40	CONTINUE
46800	240	JC=JA
46900		JA=-1
47000		INP(K)=IBLA
47100		CALL SCANR
47200		JA=JC
47300	140	JC=1
47400		KN=LIST(L+1)
47500		M=LIST(L+2)+1
47600		IF(RETRO)GO TO 640
47700		JC=M-1
47800		M=KN-1
47900		KN=JC
48000		JC=-1
48100		RETRO=-1.
48200	640	IF(INVRT)GO TO 940
48300	840	X=V(KN)
48400		V(I)=X+VX1
48500	C  FINDS CENTER FOR INVERSION (+TRANSP.)
48600		I=I+1
48700		KN=KN+JC
48800		IF(V(KN-JC).NE.85.)GO TO 940
48900		V(I-1)=85.
49000		GO TO 840
49100	
49200	940	Z=V(KN)
49300		IF(INVRT.EQ.0)GO TO 440
49400		IF(VX1.EQ.0)GO TO 540
49500	C  " @Q N "  WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
49600		IF(CODE.EQ.-33.)GO TO 440
49700		V(I)=Z*VX1
49800		GO TO 7361
49900	440	IF(Z.EQ.85.)GO TO 540
50000		Y=0
50100		IF(INVRT.EQ.0)Y=(X-Z)*2.
50200		V(I)=Z+VX1+Y
50300		GO TO 7361
50400	540	V(I)=Z
50500	7361	I=I+1
50600		KN=KN+JC
50700		IF(KN.NE.M)GO TO 940
50800	
50900		INVRT=-1
51000		RB=V(I-1)
51100	CC	ICT=-1
51200		DO 8361 L=JD,72
51300		JG=INP(L)
51400	CC	IF(JG.EQ.ISEMI)GO TO 93611
51500	C   PUT IN NOV 25, 72
51600		IF(JG.EQ.ISEMI)GO TO 93612
51700		INP(L)=IBLA
51800		IF(JG.EQ.KSLA)GO TO 9361
51900		IF(JG.EQ.')')IPRN=IPRN+1
52000	CC8361	IF(JG.EQ.'*')ICT=0
52100	8361	IF(JG.EQ.'*')IAMP=-1
52200	9361	MLX=L
52300	C  FIX THIS & =IBLA BY CHNGING DO LOOP TO 'GO TO' AT 6721,2722
52400	CC	IF(ICT.AND.QTS)GO TO 17731
52500	CC↓↓↓↓↓↓↓↓↓↓↓ CHNGD JUNE 24,73	IF(IAMP.EQ.0.AND.QTS)GO TO 17731
52600		IF(IAMP.EQ.0.AND.QTS)GO TO 1773
52700		JZ=-1
52800	CC			IF(QTS)GO TO 3013
52900	93612	IF(IAMP.EQ.0)GO TO 93611
53000	CC93612			IF(ICT.EQ.0)IAMP=-1
53100	C   NOV 25, 72
53200		IF(QTS)GO TO 3013
53300		GO TO 2722
53400	CC93611			IF(ICT.EQ.0.AND.QTS.EQ.0)GO TO 2722
53500	CC93611			IF(IAMP.AND.QTS.EQ.0)GO TO 2722
53600	C  THESE ARE FOR "LIT" ITEMS
53700	C  *******  DO NOT USE '@-' OR '@$' WITH 'LIT' ******  ! ! ! !
53800	CC			IF(QTS)GO TO 7773
53900	93611	IF(JG.EQ.ISEMI)GO TO 7773
54000		JZ=0
54100		IF(IPRN.NE.0)GO TO 1773
54200	C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION.  22/6/73
54300		GO TO 236
54400	C  LAST TIME FOR QUOTES
54500	
54600	CC93611	IF(ICT.AND.QTS)GO TO 7773
54700	C********↑↑ ↑↑ WAS TO 6017  JUNE 10,71
54800	CC	IF(QTS)GO TO 3013
54900	CC	IF(ICT)GO TO 6721
55000	C   JUMPS TO END STRING OF QUOTES
55100	6361	CONTINUE
55200		GO TO 99
55300	C @@@@@@@@@@@@@@@@@@@@@@@@@@
55400	5361	IF(N.NE.ID.OR.ISUB.NE.1)GO TO 53611
55500		IF(INP(JD+1).NE.IF)GO TO 236
55600	C  JUMP IF NOT DUTY FACTOR
55700		DF=DF-100.
55800	CC	GO TO 53611
55900		GO TO 43615
56000	53611	IF(N.NE.ISS.OR.INP(JD+1).NE.'U')GO TO 53612
56100		DF=DF-200
56200	C  FOR SUBROUTINE FLAG.  CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
56300		GO TO 43615
56400	53612	IF(N.NE.IAA)GO TO 43611
56500	C   FINDS 'ALL'.
56600		IF(INP(JD+1).NE.'L')GO TO 236
56700		ALL=-1.
56800	CC	INP(JD+2)=IBLA
56900	CC53611	INP(JD)=IBLA
57000	CC	INP(JD+1)=IBLA
57100	CC	GO TO 236
57200		GO TO 43615
57300	C  TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.
57400	
57500	C  QUAD CALL MUST BE IN 1ST OF 5 PARAMS.  QUAD MUST BE FOLLOWED
57600	C   BY SPC, / OR ;.  OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
57700	C   APPEAR BEFORE  / OR ;, BUT "ALL" MUST! APPEAR 
57800	C   BEFORE! QUAD (IF USED).
57900	C  ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
58000	C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
58100	C  QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
58200	43611	IF(N.NE.'Q'.OR.INP(JD+1).NE.'U')GO TO 4361
58300		QX=-13.
58400		DO 43612 N=JD,72
58500		J=INP(N)
58600		IF(J.EQ.IXX)QX=QX-1.
58700		IF(J.EQ.IF)QX=QX-2.
58800		IF(J.EQ.IBLA.OR.J.EQ.KSLA.OR.J.EQ.ISEMI.OR.J.EQ.',')GO TO 236
58900	43612	INP(N)=IBLA
59000	4361	IF(N.NE.'I')GO TO 43613
59100		IF(ISUB.NE.4)GO TO 43613
59200	C  NEXT MAKES INST NAME, P1 AND P2 INVISIBLE (REPLACES SEG, ETC.)
59300		INVIS(LK)=-1
59400	43615	DO 43614 L=JD,72
59500		N=INP(L)
59600		IF(N.EQ.IBLA.OR.N.EQ.','.OR.N.EQ.ISEMI.OR.N.EQ.KSLA)GO TO 236
59700	43614	INP(L)=IBLA
59800	43613	IF(N.NE.KSLA)GO TO 636
59900		MLX=JD+1
60000		JZ=-1
60100		INP(JD)=ISEMI
60200	436	IF(INP(MLX).NE.IBLA)GO TO 336
60300		MLX=MLX+1
60400		GO TO 436
60500	636	IF(N.NE.ISEMI)GO TO 936
60600	336	IF(ISUB.EQ.104)GO TO 104
60700		IF(ISUB.GT.3)GO TO 1899
60800	   	GO TO (101,102,103),ISUB
60900	C             PAR  MOV LIST  OTHERS
61000	936	IF(N.NE.IDOT)GO TO 736
61100		L=INP(JD+1)
61200		DO 836 KL=1,10
61300	836	IF(L.EQ.IDAT(KL))GO TO 236
61400		IF(CODE.EQ.-22.)INP(JD)=1
61500		GO TO 236
61600	C   CHANGES DOTTED RHYTHMS TO '1'S.
61700	736	IF(N.NE.'*')GO TO 136
61800		IAMP=-1
61900		INP(JD)=IBLA
62000	C  ******* WAS ISEMI ****** WHY?
62100	136	IF(N.NE.IQT)GO TO 236
62200		DO 1361 K=JD+1,72
62300		IF(INP(K).NE.IQT)GO TO 1361
62400		JD=K+1
62500		GO TO 975
62600	C   SKIPS MATE∧aP⊂⊂IN QUOTES
62700	1361	CONTINUE
62800		GO TO 99
62900	C   OPEN QUOTES
63000	236	JD=JD+1
63100		IF(JD.LT.73)GO TO 975
63200		TYPE 1236
63300		GO TO 99
63400	1236	FORMAT(' MISSING SEMICOLON')
     

00100	101	N=INP(ML)
00200		IZ=ML
00300		ML=ML+1
00400		IF(N.EQ.IBLA)GO TO 101
00500	C ⊗⊗⊗⊗⊗ MAY 13,71 @@@@@@@@@@
00600		JA=-1
00700		IF(N.EQ.IPP)GO TO 1
00800		IF(N.EQ.IE)GO TO 2308
00900		IF(N.EQ.'R')GO TO 2337
01000	C   'RUN' MAY REPLACE 'END' FOR LAST INST.
01100		IF(N.EQ.ID)GO TO 7720
01200		GO TO 99
01300	1	CALL SCANR
01400	 	LPAR=VX1
01500		IJ=LPAR
01600		IF(QX.GE.0)GO TO 5703
01700		IJ=LPAR+4
01800	C  SETS UP PARAM FOR QUAD CALL
01900		V(I)=IJ+LK*10000
02000		V(I+1)=2*ALL
02100	C  TEST "ALL" FEATURE HERE!!!!!!!
02200	C  X=-13(DEGREES),=-14(X,Y),=-15(CIRCLE FUNCTS),=-16(LINE FUNCTS)
02300		V(I+2)=QX
02400		I=I+3
02500		QX=0.
02600	5703	IAMP=0
02700		IF(IJ.GT.NP(LK).AND.IJ.LT.31)NP(LK)=IJ
02800		IF(LPAR.EQ.32)LPAR=1
02900		V(I)=LPAR+LK*10000
03000	C  +1=WDCNT, +2=CODE, +3='NM' CCCCC
03100		IJ=I+1
03200		I=I+4
03300		ITMP=0
03400		CODE=0
03500		NFLG=1
03600		ML=IZ+M
03700	C   RE=REP  R=RHY  L=LIT  M=MOVE  MX=MOVX  N=NOTES  NU=NUM  
03800	C   S--L=SUBL  S--N=SUBN  T=TAP  RT=RTAP  RL=RLIST  RN=RNOTES
03900	C  QU=QUADC  QUX=QUADX 
04000	5702	ML=ML+1
04100		IF(ML.GT.72)GO TO 99
04200		N=INP(ML)
04300		IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 5702
04400		NL=INP(ML+1)
04500		JA=-1
04600		ISUB=0
04700		IF(N.EQ.IXX)GO TO 2703
04800		IF(N.EQ.'R')GO TO 6702
04900		IF(N.EQ.IF)GO TO 8702
05000	CC	IF(N.EQ.ID)GO TO 1703
05100	4005	JA=0
05200		IF(N.EQ.IEN)GO TO 6005
05300		IF(N.EQ.'M')GO TO 703
05400		IF(N.EQ.'L')GO TO 2720
05500		IF(N.EQ.ISS)GO TO 6703
05600		IF(N.EQ.ITT)GO TO 4018
05700		IF(N.EQ.IQT)GO TO 5720
05800		IF(N.EQ.ISEMI)GO TO 2018
05900		IF(N.EQ.IPP)JA=-1
06000	C  FOR /P5  P3/
06100		CALL SCANR
06200		IF(ISUB.EQ.8)GO TO 8
06300		I=I+JJ
06400		V(IJ+1)=NNUM+DF
06500		IF(JJ.EQ.1)GO TO 4006
06600	C  IF NNUM IS '-2' THEN NOTES ARE PRINTED
06700		IF(NNUM.NE.-2)GO TO 5006
06800		IX=IJ+3
06900		DO 2006 K=2,JJ,3
07000	CC    X=VX(K)
07100	CC    Y=VX(K+1)
07200	CC    IF(X.GT.Y)VX(K)=X+.999
07300	CC2006      IF(Y.GT.X)VX(K+1)=Y+.999
07400	2006  CALL RANR(VX,K)
07500	C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
07600	5006	IX=IJ+2
07700		DO 6006 K=1,JJ
07800	6006	V(IX+K)=VX(K)
07900		V(IX+JJ-2)=1.
08000	C  ABOVE ENSURES THAT LAST RAND. UNIT REACHES 100% - 5/74 *********
08100		GO TO 3013
08200	4006	IF(JA)VX1=VX1/100.+9999.
08300	C  CHANGES /P5 P3/ TO /P5 9999.03/
08400		V(I-1)=VX1
08500		GO TO 3013
08600	6702	IF(NL.EQ.IE)GO TO 2703
08700	C   JUMP IF "REP"
08800		IF(NL.EQ.ITT)GO TO 4018
08900	C   JUMP IF "RTAP"
09000		CODE=-22
09100		IF(NL.EQ.'L')CODE=-46.0
09200	C   JUMP IF "RLIST" (LIST OF RAND SELECTIONS)
09300		IF(NL.NE.IEN)GO TO 1016
09400	C   JUMP IF NOT "RNOTES"
09500		JA=0
09600	C   FOR SCANR
09700		CODE=-36.
09800		GO TO 1016
09900	6005	CODE=-33
10000		IF(NL.NE.'U')GO TO 1016
10100		CODE=-44.
10200	1610	JA=-1
10300		GO TO 1016
10400	8702	CODE=-35
10500		IF(NL.EQ.'U')GO TO 1016
10600		ML=ML+1
10700		CALL SCANR
10800	7	V(IJ+1)=CODE+DF
10900		V(IJ+2)=1.
11000		V(I)=VX1+85.
11100		GO TO 7703
11200	703	BW=V(IJ-2)
11300		IC=0
11400		DO 7031 K=ML+1,72
11500		IF(INP(K).EQ.ISEMI)GO TO 8031
11600	7031	IF(INP(K).EQ.IXX)IC=-1
11700	C****************  JUNE 1,71   X 4
11800	8031	I=I-1
11900		V(I)=0
12000	C ********* FEB. 15,71
12100		X=-9900.-BY
12200		IF(BY.EQ.0)X=-9900.-BG(LK)
12300	   	IF(BW.EQ.X)GO TO 8005
12400		IF(BW.NE.-9900.-BY)GO TO 1102
12500		V(IJ-2)=X
12600		GO TO 8005
12700	1102	V(IJ)=V(IJ-1)
12800		V(IJ-1)=X
12900		IJ=IJ+1
13000		I=I+1
13100	8005	LP=IJ-1
13200		BW=-9900.-X
13300		ISUB=2
13400		IZ=-1
13500	C  ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
13600	4703	GO TO 1299
13700	102	IF(IZ.LT.0)GO TO 2102
13800		BW=V(ICT)+BW
13900		V(I)=-9900.-BW
14000		V(I+1)=V(LP)
14100		V(I+2)=(JJ+2)*ALL
14200		V(I+3)=CODE+DF
14300		I=I+4
14400		IZ=1
14500	2102	IF(BW.LT.10000.)CALL BGSORT(BW)
14600	C   ROUND-OFF NONSENSE
14700	2	VX3=-9900.
14800		VX2=VX3 
14900		CALL SCANR
15000		IF(JJ.EQ.4)GO TO 99
15100		IF(VX3.NE.-9900.)GO TO 3102
15200		IF(VX2.NE.-9900.)GO TO 4102
15300		VX2=VX1
15400		VX1=10000.
15500	4102	VX3=VX2
15600		JJ=3
15700	C  1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
15800	3102	IF(IZ.GE.0)GO TO 3006
15900		V(IJ)=(JJ+2)*ALL
16000	C  WORD COUNT
16100		CODE=-55.
16200		IF(JJ.NE.3)CODE=-57.
16300	C  THIS IS NOW OUT, FEB 15,70.  -10000. MEANS 'NOTES AT BG TIME 0'
16400		IF(NFLG)CODE=CODE-1.
16500		IF(IC)CODE=-59.
16600	C****************  JUNE 1,71   
16700	C  CODE=-56 OR -58 FOR NOTES.
16800		V(IJ+1)=CODE+DF
16900		IZ=0
17000	3006	IF(NFLG.EQ.1)GO TO 5005
17100	CC    IF(VX2.GT.VX3)VX2=VX2+.999
17200	CC    IF(VX3.GE.VX2)VX3=VX3+.999
17300	CC    IF(JJ.EQ.3)GO TO 5005
17400	CC    IF(VX4.GT.VX5)VX4=VX4+.999
17500	CC    IF(VX5.GE.VX4)VX5=VX5+.999
17600	      CALL RANR(VX,2)
17700	      IF(JJ.NE.3)CALL RANR(VX,4)
17800	C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
17900	5005	ICT=I
18000	  	IJ=IJ+1
18100		DO 1006 K=1,JJ
18200	1006	V(IJ+K)=VX(K)
18300		I=I+JJ  
18400		IJ=I+2
18500		IF(IAMP.EQ.0)GO TO 1299
18600	C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
18700		V(I)=-9900.-BY
18800		GO TO 8703
18900	CC1703	IF(NL.NE.IF)GO TO 4005
19000	CC	CODE=-45.
19100	CC	GO TO 1016
19200	C   ABOVE IS**** WAS ***** FOR 'DF'  (DUTY FACTOR)
19300	7703	V(IJ)=4.*ALL
19400	8703	I=I+1
19500		GO TO 4773
19600	C   FOR SUBROUTINES, -12=NUMS.  -11=LETTERS.
19700	6703	CODE=-12.
19800		IF(INP(ML+3).EQ.'L')CODE=-11.
19900		V(IJ)=2.*ALL
20000		V(IJ+1)=CODE+DF
20100		I=I-1
20200		GO TO 4773
20300	4018	CNT(LK)=-9900.-BY
20400		P(LK)=V(I-4)
20500		JREAD=3
20600		GO TO 4400
20700	C   JUMPS TO READER
20800	443	IF(LN.NE.0)REREAD 107,K,IPT(LK,1)
20900		IF(LN.EQ.0)REREAD 8001,IPT(LK,1)
21000	C   NAME OF RHYTHM FILE. (ONLY ONE PER INST.)  READS DATA JUST BEFORE RUN
21100		IF(NL.NE.ITT)GO TO 2338
21200		CODE=-23.
21300		GO  TO 1016
21400	2338	I=I-4
21500		GO TO 4773
21600	3018	CNT(KZY)=-9900.
21700		JREAD=4
21800		GO TO 4400
21900	444	IF(LN.NE.0)REREAD 107,K,IPT(KZY,1)
22000		IF(LN.EQ.0)REREAD 8001,IPT(KZY,1)
22100		P(KZY)=980000.
22200		GO TO 2308
22300	C   CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
22400	C  'REP'
22500	2703	ML=ML+1
22600		VX1=0
22700		VX2=0
22800		VX3=0
22900		IF(N.EQ.IXX)GO TO 2704
23000		INP(ML)=IBLA
23100		INP(ML+1)=IBLA
23200	C  WIPES OUT 'EP' IN 'REP'
23300	2704	CALL SCANR
23400	 	V(IJ)=3.
23500		V(IJ+1)=-66.0
23600		IF(VX1.EQ.32.)VX1=1.
23700		IF(VX1.EQ.0)VX1=LPAR
23800		IF(VX2.EQ.0)VX2=LK-1
23900		V(IJ+2)=VX1+VX2*10000.
24000		KL=VX2
24100		IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
24200		IF(VX3.EQ.0)GO TO 4773
24300		L=VX3
24400		ML=LK+1
24500		DO 1018 KL=ML,L
24600		IF(LPAR.GT.NP(KL).AND.LPAR.LT.31)NP(KL)=LPAR
24700		IF(DUR(KL))DUR(KL)=DUR(LK)
24800	C  TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
24900		V(I)=V(I-4)+10000.
25000		V(I+1)=3.
25100		V(I+2)=-66.
25200		V(I+3)=V(I-1)
25300	1018	I=I+4
25400		GO TO 4773
25500	
25600	2018	IF(DF.EQ.0)GO TO 20181
25700	C NEXT FOR Pn SUBR/ I.E. NOTHING BUT P AND SUB CALL. 7/73
25800		V(IJ+1)=-201.
25900		V(IJ+2)=1.
26000		V(IJ+3)=0
26100		GO TO 7703
26200	20181	V(IJ)=3.
26300		V(IJ+1)=-66.
26400		V(IJ+2)=NW+LK*10000
26500		GO TO 4773
26600	C  READS /P5  .3 "ABC" .7 "XYZ"/
26700	
26800	8 	V(IJ+1)=-77.+DF
26900	C  DF HAS SUBR CALL INFO
27000		I=I+1
27100		VX(JJ-1)=1
27200	C  FOR RAND. SINGLE LITS.
27300		DO 3722 K=1,JJ,2
27400		V(I)=VX(K)
27500	3722	I=I+1
27600		V(IJ+2)=JJ/2
27700		V(IJ+3)=I
27800		DO 4722 K=2,JJ,2
27900		KN=I
28000		I=I+1
28100		L=VX(K)
28200		DO 6722 KL=L,72
28300		IF(INP(KL).EQ.IQT)GO TO 4722
28400		IV(I)=INP(KL)
28500	6722	I=I+1
28600	4722	V(KN)=I-KN-1
28700		V(IJ)=(I-IJ)*ALL
28800		GO TO 4773
28900	2720	QTS=0
29000		ISUB=104
29100		GO TO 1299
29200	
29300	104	DO 6721 K=ML,72
29400		JC=K+1
29500		IF(INP(K).EQ.IQT)GO TO 7721
29600	6721	IF(INP(K).EQ.KSLA.OR.INP(K).EQ.ISEMI)GO TO 7232
29700	C  FOR REPEAT OF ITEM BY SLASH
29800	7232	DO 7231 K=I-1,1,-1
29900		IF(ABS(V(K)).GT.72.)GO TO 7231
30000		NL=V(K)
30100		DO 7230 KL=K,K+NL
30200		V(I)=V(KL)
30300	7230	I=I+1
30400		GO TO 27222
30500	7231	CONTINUE
30600	
30700	5720	IAMP=-1
30800		JC=ML+1
30900	C  FOR SINGLE 'LIT' ITEMS.
31000	7721	DO 1722 KL=JC+1,72
31100		IF(INP(KL).NE.IQT)GO TO 1722
31200		JD=KL-1
31300		ML=KL+1
31400		NL=KL-JC
31500	C   EXTENT OF LIT ITEM IS FOUND
31600		GO TO 8721
31700	1722	CONTINUE
31800	C  CAN'T USE SLASH FOR REPEAT AFTER @Q
31900	8721	V(I)=NL
32000		DO 9721 K=JC,JD
32100	C   PUTS ITEM IN "IV" ARRAY
32200		I=I+1
32300	9721	IV(I)=INP(K)
32400		I=I+1
32500	27222	IF(IAMP.EQ.0)GO TO 1299
32600	2722	V(I)=999.
32700		QTS=-1.
32800	27221	V(IJ+1)=-88.+DF
32900		V(IJ)=(I-IJ+1)*ALL
33000		IJ=IJ+2
33100		V(IJ)=IJ+1
33200		I=I+1
33300		ISUB=1
33400		GO TO 1299
33500	
33600	7720	V(I)=LK
33700		V(I+1)=3.
33800		V(I+2)=-67.
33900		ML=ML+4
34000		CALL SCANR
34100	 	V(I+3)=VX1
34200		I=I+4
34300		L=VX1
34400		IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
34500		IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
34600		GO TO 4773
34700	C   TYPE 'DUPL N;'   N=INST # TO BE DUPLICATED.
34800	142	FORMAT(I,15A5) 
34900	1301	FORMAT(15A5) 
35000	2773	FORMAT(I,A5,72A1) 
35100	2114  FORMAT(I,72A1)
35200	300	FORMAT(I,3F,A1)
35300	301	FORMAT(3F,A1)
35400	6 	KB=KB+1
35500		IF(JED.GT.0)JED=0
35600		IF(J.EQ.'INSER')GO TO 1340
35700	      OTH(KB,1)=VX1*100000.+VX2*100.+VX3   
35800	      GO TO 340   
35900	1340	X=VX1
36000		IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2    
36100		OTH(KB,1)=X
36200		GO TO 1338
36300	C   ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR
36400	C   INSTRUMENT.  FOR COMMENT AT START, SET BG TIME TO 1,1 
36500	C   - BEGIN LINE WITH  <,END WITH ; 
36600	C   UP TO 75 CHARACTERS MAY BE TYPED.     
36700	340      IF(VX3.NE.2)GO TO 1338 
36800		IF(ITYP.GE.0)GO TO 449
36900		JREAD=5
37000		GO TO 4400
37100	445	OTH(KB,3)=1.
37200		IF(LN.EQ.0)GO TO 447
37300		REREAD 300,K,OTH(KB,2)
37400		GO TO 1447
37500	447	REREAD 301,OTH(KB,2)
37600	1447	IF(JED)GO TO 2308
37700	3445	TYPE TEDIT
37800		ACCEPT 77732,K
37900		IF(K.EQ.'G')JED=-1
38000		IF(J.EQ.'INSER')GO TO 3446
38100		IF(K.NE.'Y'.OR.JED)GO TO 2308
38200	449	TYPE TPALN
38300		ACCEPT 301,OTH(KB,2)
38400		IF(JED)WRITE(21,301) OTH(KB,2)
38500		GO TO 2308
38600	
38700	1338	IF(ITYP.GE.0)GO TO 1449
38800		JREAD=6
38900		GO TO 4400
39000	446	IF(LN.EQ.0)GO TO 448
39100		REREAD 142,K,(OTH(KB,JD),JD=2,16)    
39200		GO TO 1446
39300	448	REREAD 1301,(OTH(KB,JD),JD=2,16)    
39400	1446	IF(JED)2446,3445,2446
39500	3446	IF(K.NE.'Y'.OR.JED)GO TO 2446
39600	1449	TYPE TPALN
39700		ACCEPT 1301,(OTH(KB,JD),JD=2,16)
39800		IF(JED)WRITE(21,1301)(OTH(KB,JD),JD=2,16)
39900	2446	X=OTH(KB,2)
40000		IF(J.EQ.'INSER'.AND.VX3.NE.0.AND.X.NE.'*')GO TO 6
40100		IF(X.EQ.'*')KB=KB-1
40200	C   ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #.
40300	C   LAST LINE HAS '*' IN COLUMN 1.
40400		GO TO 2308
40500	C   IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED.
40600	C   INSERT MAY INCLUDE 10 CHARS(P3-P30),
40700	C   P2, A # ONLY.  IF MORE THAN 1 PARAM IS TO BE EDITED AND
40800	C   P2 IS ONE OF THEM, FIRST EDIT P2 TO DESIRED VALUE,
40900	C   CHANGE P2 TO MINUS = THEN INSERT ENTIRE NOTE TO PLAY
41000	C   JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
41100	C   BX=INST N. Y=NOTE N. Z=PARAM N. 
41200	1899	CALL SCANR
41300		GO TO(1,2,3,4,5,6),ISUB
     

00100	1106	KTMP=1
00200		TP=60.
00300		IAMP=0
00400		BW=BY
00500		ITMP=-1
00600		ISUB=5
00700		JA=-1
00800		GO TO 2016
00900	3019	V(I)=990000.00
01000		V(I+1)=4.
01100		V(I+2)=VX1
01200		V(I+3)=VX2/TP
01300		V(I+4)=VX3/TP
01400		I=I+5
01500		BY=BW
01600	C  SEPT 18, 70
01700		IF(VX1.EQ.0)GO TO 2308
01800		BW=BW+VX1
01900		V(I)=-9900.-BW
02000		I=I+1
02100		CALL BGSORT(BW)
02200	9003	IF(IAMP)GO TO 4003
02300	2016	VX3=0
02400		VX2=0
02500		GO TO 1299
02600	5	IF(VX2.NE.0)GO TO 105
02700	C  'TEMPO/120*;'  OR  'TEMPO/1.5 72*;'  IS OK.
02800		VX2=VX1
02900		VX1=0
03000	105	IF(VX3.EQ.0)VX3=VX2
03100		IF(VX2.LT.11.)TP=1.
03200		IF(J.EQ.ITMPO)GO TO 3019
03300	  	PCH(1,KTMP)=VX1
03400		PCH(2,KTMP)=VX2
03500		PCH(3,KTMP)=VX3
03600	C   PCH(1)=TIME  (2)=MM1  (3)=MM2
03700		KTMP=KTMP+1
03800		IF(IAMP.EQ.0)GO TO 2016
03900	4003	VX1=0
04000		IAMP=0
04100		VX2=VX3
04200		IF(J.EQ.ITMPO)GO TO 3019
04300		PCH(1,KTMP)=0
04400		PCH(2,KTMP)=VX2
04500		PCH(3,KTMP)=VX2
04600	C   MM CAN BE FROM 11 UP  ITMPO FACTOR FROM 10 DOWN.  
04700	C   UP TO 30 ITMPO CHANGES MAY BE MADE.   
04800	
04900	1016      IA=I    
05000	      IZ=1  
05100	3100	V(I-2)=CODE+DF
05200	      ISUB=3     
05300	5016	IF(IAMP.GE.0)GO TO 1299
05400	117	IF(IZ-2)3013,9004,9004
05500	103	K=INP(ML)
05600		IF(K.EQ.ITT)GO TO 1106
05700		IF(K.EQ.ISEMI)GO TO 1014
05800		IF(K.NE.IBLA) GO TO 1899
05900		ML=ML+1
06000		GO TO 103
06100	C@@@@@@@@ MAY 13,71 @@@@@@
06200	C**********FEB 19,71
06300	C  ABOVE 
06400	3      IF(VX1.EQ.-99.)GO TO 4022
06500		IF(CODE.EQ.-22.)GO TO 2017
06600	C************ MAY 19,71
06700	  	IF(CODE.LT.-23.OR.IZ/2*2.EQ.IZ)GO TO 17
06800	C    CHECKS PAIRS OF NUMBERS FOR 'RTAP'
06900	2017	IF(VX1.EQ.10000.)GO TO 17
07000	      VX1=4./VX1
07100		IF(JJ.NE.1)GO TO 2014
07200		V(I)=VX1
07300		GO TO 114
07400	
07500	1217	IF(VX1.EQ.10000.)GO TO 114
07600	C    FOR "FINE" IN LIST
07700	CC    IF(CODE.EQ.-46.)GO TO 4217
07800	CC    IF(VX1.GT.VX2)V(I)=VX1+.999
07900	CC    IF(VX2.GT.VX1)VX2=VX2+.999
08000	C   ABOVE EXTENDS RANGE TO GIVE HIGHEST NOTE A CHANCE
08100	CC4217      V(I+1)=VX2
08200	      V(I+1)=VX2
08300	      IF(CODE.EQ.-36.)CALL RANR(V,I)
08400	2217	I=I+1
08500	C  SETS UP STRING OF RAND SELECTIONS
08600		GO TO 114
08700	3217	V(I)=V(I-2)
08800		V(I+1)=RB
08900	C  FOR SLASH REPTS OF RAND SELEC UNITS. ("REP" CAN'T BE USED!)
09000		GO TO 2217
09100	C******** PUT IN ERROR TRAP FOR "REP" ETC. ******
09200	
09300	2014	DO 9006 L=2,JJ
09400		IF(VX(L).EQ.0)GO TO 17
09500	9006	VX1=4./VX(L)+VX1
09600		JJ=1
09700	17	V(I)=VX1
09800		IF(CODE.EQ.-46..OR.CODE.EQ.-36.)GO TO 1217
09900	C  JUMP IF STRING OF RAND SELECS.
10000		IF(JJ.EQ.1)GO TO 114
10100		L=VX(JJ)-1
10200		X=V(I)
10300		NL=I+1
10400		I=L+I
10500		DO 1017 K=NL,I
10600	1017	V(K)=X
10700	C   ADDS UP TOTAL   OF NOTES IN SEQ.
10800		IZ=IZ+L
10900		GO TO 114
11000	1014	IF(CODE.EQ.-46..OR.CODE.EQ.-36.)GO TO 3217
11100		V(I)=RB
11200	C   RB SAVES IT FOR SLASH REPEAT
11300	114      RB=V(I)     
11400	      I=I+1 
11500	      IZ=IZ+1     
11600	      GO TO 5016    
11700	4022      JC=VX2+.3
11800	      JD=VX3-.5
11900		IF(JJ.EQ.2)JD=1
12000	C********* MAY 19,71   ----MANY LINES ABOVE.
12100	      IZ=IZ+JC*JD 
12200	C   JC=HOW MANY TIMES,  JD=HOW MANY NOTES 
12300	      DO 1005 K=1,JD    
12400	       NL=I+JC-1  
12500	      DO 2005 L=I,NL    
12600	2005  V(L)=V(L-JC)
12700	1005      I=I+JC  
12800		RB=V(NL)
12900	C  RB SAVES DATA FOR SLASH REPEAT FEATURE.
13000	      GO TO 5016  
13100	
13200	9004	IF(ITMP.EQ.0)GO TO 3013
13300	C*********** JUNE 1,71
13400		IZ=IZ-1
13500	C***** JAN. 1974
13600	      KA=1  
13700	      IC=1  
13800	      K=0   
13900		J=1
14000	      Z=0   
14100	      RC=0  
14200	9007	Y=PCH(3,IC)/TP
14300		X=PCH(2,IC)/TP
14400	      Z=PCH(1,IC) 
14500		CALL SQYY(YY,X,Y,Z)
14600		XT(1)=X
14700	      XA=RA 
14800	      RD=1  
14900	      RB=0  
15000	      ZZ=Z  
15100	7020      RA=V(IA+K)    
15200		IF(RA.EQ.10000.)GO TO 3013
15300	4020  RD=1  
15400	      IF(RA.LT.0)RD=-1. 
15500	      RA=RA*RD    
15600	      IF(KA.EQ.0)RA=RA-RC     
15700	      W=RA  
15800	      RB=W  
15900	      IF(W.LE.Z)GO TO 2020    
16000	      IF(Z.NE.0)GO TO 3020    
16100	      RA=RA/Y     
16200	      RB=-1.
16300	      RC=0  
16400	      GO TO 8020  
16500	3020      W=Z     
16600	      RC=W+RC     
16700	      GO TO 24    
16800	2020      RC=0    
16900	24	IF(X.NE.Y)GO TO 424
17000		RA=W/X
17100		GO TO 8020
17200	C   DUR OF TMP + BG TIME OF TMP - NOTE VALUE - 
17300	C   BG TIME OF NOTE. CHN=TBG.
17400	424	RAX=XT(J)
17500		RA=(-2.*RAX+(4.*RAX**2+8.*YY*W)**.5)/(2.*YY)
17600		XT(J)=RAX+YY*RA
17700	8020      IF(KA.EQ.0)RA=RA+XA 
17800	      KA=1  
17900	      IF(RC.NE.0)GO TO 1011   
18000	      IF(T5.EQ.1)GO TO 8203   
18100	      V(IA+K)=RA*RD     
18200	      IF(K.EQ.IZ)GO TO 3013     
18300	C*********** JUNE 1,71
18400	1011      IF(T5.EQ.1)GO TO 2011     
18500	      K=K+1 
18600	      IF(ZZ.NE.0)Z=Z-W  
18700	      IF((Z.GT.0).OR.(RB.EQ.-1.))GO TO 7020     
18800	      IC=IC+1     
18900	      IF(RB.EQ.W)GO TO 9007
19000	      KA=0  
19100	      K=K-1 
19200	      GO TO 9007     
19300	C********* MAY 13,71  OMITS REPEATED RHY. FEATURE.
19400	C     ML=I-1
19500	C     ML=I-1
19600	C*********** MAY 13,71 ********
19700	3013	X=I-IJ
19800		V(IJ+2)=X-3.
19900		V(IJ)=X*ALL
20000		IF(CODE.NE.-35)GO TO 4773
20100		M=IJ+3
20200	C   SETS NUMBERS FOR FUNCS.
20300		DO 313 K=M,I-1
20400	313	IF(V(K).LT.85.)V(K)=V(K)+85.
20500		GO TO 4773
20600	
20700	2011      XA=RA   
20800		IF(K.GT.1)GO TO 9020
20900		K=I-6
21000	      ZPAR=-9900.-CHN-ZZ
21100	      DO 3011 KL=8,I     
21200	      IF((V(K).EQ.ZPAR).AND.(V(K+1).EQ.990000.))GO TO 9020    
21300	3011      K=K-1
21400	9020      W=ZZ  
21500		IF(V(K+3))K=K+3
21600	C   ABOVE IS FOR TYPED IN TEMPO CHANGES
21700		KA=K+3
21800	      ZZ=V(KA)
21900	C   DUR OF NEXT TEMPI
22000		X=V(KA+1)
22100		Y=V(KA+2)
22200	213      KA=0  
22300	      Z=ZZ  
22400		CALL SQYY(YY,X,Y,Z)
22500	      CHN=CHN+W   
22600		XT(J)=X
22700	      IF(KA.EQ.1)Z=0    
22800	      RA=PR 
22900		KA=0
23000		K=K+3
23100		GO TO 4020
     

00100	2337	T=0
00200		DO 1107 K=1,30
00300	1107	PL(K)=1.
00400	C  2/74--WAS AT 17300/1   SETS DEFAULT OUTPUT MODE TO 1.
00500		IF(ITYP)GO TO 23371
00600		END FILE 21
00700		DATA ENFI /25H(' INPUT ON FOR21.DAT'/) /
00800		TYPE ENFI
00900	C  PUTS AWAY TYPED IN DATA. TO REUSE, EDIT FOR21.DAT.
01000	23371	IF(SOS)WRITE(JOUT,902)
01100	C   WRITES A BLANK LINE
01200		NWZZ=0
01300		IAMP=0
01400		IT3=0
01500		K=1
01600	      IX=0  
01700		BG(NINS+1)=19999.
01800	4011	IF(CNT(K))GO TO 5011
01900	6011	IF(K.EQ.KZY)GO TO 4337
02000		K=K+1
02100		GO TO 4011
02200	5011	L=V(I-1)/(-9900.)
02300		IF(L.EQ.1)I=I-1
02400		V(I)=CNT(K)
02500		V(I+1)=P(K)
02600		V(I+3)=-44.
02700		I=I+5
02800		IF(P(K).EQ.980000.)I=I-4
02900		KL=I
03000		REWIND 1
03100		ICT=IPT(K,1)
03200		CALL IFILE(1,ICT)
03300	9011	L=I+6
03400		READ(1,7011)(V(M),M=I,L)
03500	C   READS "CONDUCT" AND "RHYTHM" (TAP) DATA.
03600		IF(V(L).EQ.999.)GO TO 8011
03700		I=L+1
03800		GO TO 9011
03900	8011	IF(P(K).NE.980000.)GO TO 6337
04000		DO 7337 K=L,I,-1
04100	7337	IF(V(K).NE.999.)GO TO 8337
04200	8337	I=K-1
04300		V(I)=0
04400		V(I+1)=V(K)
04500		V(I+2)=V(K)
04600	C   K WAS I-1 ABOVE.
04700		I=I+3
04800		V(KL+1)=I-KL-1
04900	C  ABOVE RESETS WORDCOUNT FOR 'CONDUCT' DATA.
05000		GO TO 4337
05100	6337	DO 5337 M=I,L
05200		KN=M
05300	5337	IF(V(M).EQ.999.)GO TO 3337
05400	3337	I=KN
05500		KN=I-KL
05600		V(KL-1)=KN
05700		V(KL-3)=KN+3
05800		GO TO 6011
05900	7011	FORMAT(7F)
06000	4337	IF(V(I-1).EQ.-9900.-BY)I=I-1
06100		V(I)=-19899.
06200	      PP1=0
06300	      T6=10000.   
06400	      DO 2118 K=1,NINS  
06500		ROFF(K)=0
06600	C********* FEB 17,71
06700		M=NP(K)
06800	      IT(K)=0 
06900		IPT(K,31)=0
07000		NCNT(K,31)=1
07100		DO 2118 L=1,M
07200		NCNT(K,L)=1
07300	2118	IPT(K,L)=0
07400		DO 5013 K=1,IXIN
07500	5013	X=RAND(0.0,0.0)
07600		REWIND 1
07700		IF(MX)CALL OFILE(1,ISLAC)
07800	      NW=1    
07900		NWX=0
08000	      TDUR=0
08100		A=0
08200	      T2=1. 
08300	      T4=1. 
08400	      T5=0  
08500		J=1
08600	      MK=0  
08700	C   IS THE ABOVE NEEDED?
08800		IF(MX.NE.3)GO TO 40021
08900		K=4
09000	CC10023	N=V(K)/-11.
09100	10023	N=AMOD(V(K),100.0)/-11.
09200	C  AMOD NEEDED BECAUSE CODE # MAY HAVE -100 FOR DF OR -200 FOR SUBR.
09300		IF((N.NE.2.AND.N.NE.3.AND.N.NE.4).OR
09400		1 .V(K-2).LT.10000.)GO TO 10021
09500		J=V(K+1)
09600		IF(J.EQ.1)GO TO 10024
09700		IF(N.EQ.3.AND.V(K+J+1).EQ.101.)J=J-1
09800		N=V(K-2)
09900		L=N/10000
10000		M=N-L*10000
10100		TYPE 10022,INST(L),M,J
10200	10024	K=K+ABS(V(K-1))
10300	10021	K=K+1
10400		IF(K.LT.I)GO TO 10023
10500	40021	IF(MZ.NE.-4)GO TO 1002
10600		N=1
10700	40022	K=N+1
10800		IF(N.GT.I)CALL EXIT
10900		X=V(N)
11000		IF(X.EQ.-199..OR.X.EQ.-99.)GO TO 40024
11100		IF(X.GE.0)GO TO 40023
11200		PRINT 4002,X
11300		N=N+1
11400		GO TO 40022
11500	40024	J=N+1
11600		GO TO 40025
11700	C  FOR 'SECTIONS'
11800	40023	J=ABS(V(K))+K-1
11900	40025	PRINT 4002,(V(K),K=N,J)
12000		N=J+1
12100		GO TO 40022
12200	10022	FORMAT(1XA5,' P',I2,'  HAS ',I3,' ITEMS.')
12300	4002  FORMAT(10F12.3)
12400	1002	IF(IDALL)GO TO 600
12500		X=DUR(IDALL)
12600		DO 2002 K=1,NINS
12700	2002	IF(DUR(K))DUR(K)=X
     

00100	C ***** SORTER *************************  
00200	C  *******  OUTPUT LOOP FROM HERE ON  ********
00300	600      IL=0     
00400	C********** BELOW IS FOR 'SECTIONS'
00500		KODE=0
00600		NWX=NWX+1
00700	      MK=MK+1     
00800	      Y=BNW(NW)   
00900	723      IL=IL+1  
01000	3723      Z=V(IL)     
01100	      IF(Z.EQ.-19899.)GO TO 732
01200	      IF(Z.NE.-9900.-Y)GO TO 723     
01300	C********** BELOW IS FOR 'SECTIONS'
01400		IF(V(IL-2).EQ.-199.)KODE=IV(IL-1)
01500	2723      IL=IL+1   
01600	729	K=IL+2
01700		MOT=V(IL+1)
01800		RD=V(K)
01900		IF(RD.EQ.-67.)GO TO 3726
02000		RB=V(IL)
02100	C************ DOWN TO 4150 IS FOR 'SECTIONS'
02200		IF(RB.NE.-99.)GO TO 4150
02300		KODE=IV(K-1)
02400	2160	IF(KODE.EQ.0)GO TO 723
02500	  	IF(MZ)WRITE(JOUT,9150),KODE
02600		KL=Y/10000.
02700		RB=Y+KL*10000.
02800		DO 5150 KL=1,I
02900		IF(V(KL).NE.-199..OR.IV(KL+1).NE.KODE)GO TO 5150
03000		IV(K-1)=0
03100	C  WHEN 'PLAY' HAS BEEN FOUND, INDENTIFIER CHNGED TO 0
03200		RD=V(KL+2)+9900.
03300		DO 6150 L=KL+2,I
03400		M=V(L)/(-9900.)
03500		IF(M.NE.1)GO TO 6150
03600		RA=RB+RD-V(L)-9900.
03700		V(L)=-9900.-RA
03800	C  UPDATES BG TIMES INSIDE SECTION.
03900		CALL BGSORT(RA)
04000	C7150	IF(RA.EQ.BNW(KA))GO TO 6150
04100	C  UPDATES LIST OF CHANGE TIMES.
04200	6150	IF(V(L).EQ.-299.)GO TO 160
04300	5150	CONTINUE
04400	160	IL=1
04500		GO TO 3723
04600	C***********  ABOVE IS FOR 'SECTION' REPEATS
04700	4150	LK=RB/10000.+.2
04800		IF(LK.GE.98)GO TO 7700
04900		LP=RB-LK*10000
05000	C   LK=INST #   LP=PARAM #
05100		LN=IPT(LK,LP)
05200		IPT(LK,LP)=IL+2
05300		IF(RD.EQ.-66.)GO TO 726
05400		IF(RD.EQ.-55..OR.RD.EQ.-56.)GO TO 1726
05500		IF(RD.EQ.-23)GO TO 6700
05600	
05700	2727	ML=IPT(LK,LP)
05800		IF(MOT.GT.0)GO TO 3727
05900	C  USE NEG WDCNT FOR 'ALL'
06000		DO 4727 KL=LK+1,NINS
06100		IF(NP(KL).LT.LP.AND.LP.LT.31)NP(KL)=LP
06200		IPT(KL,LP)=-(LK+(LP-1)*KZY)
06300		NCNT(KL,LP)=10000
06400	4727	IF(DUR(KL))DUR(KL)=1000.
06500	C  ASSUMES THAT DURATIONS ARE SET IN 'NOTES'.
06600	C  AFTER 'ALL' IS USED ONCE IT WORKS LIKE DUPL OR REP.
06700	CC	GO TO 2150
06800	C ABOVE CHANGED TO BELOW DEC.6,72.  'ALL' WAS OMITTING 1ST ITEM.
06900		GO TO 727
07000	C 'MOVE' WITH 'ALL' KEEPS ORIGINAL TIME DATA REGARDLESS OF BG TIMES.
07100	3727	IF(V(IL).NE.V(LN-1).OR.LN.EQ.0)GO TO 727
07200	CC ************  JAN 20 ***********
07300		DO 1727 L=1,NINS
07400		DO 1727 KL=1,NP(L)
07500		IF(LN.NE.IPT(L,KL))GO TO 1727
07600		NCNT(L,KL)=10000
07700	C ******* JAN 29,70
07800		IPT(L,KL)=ML
07900	C RESETS POINTERS FOR DUPL AND REP INSTS.
08000	C *** 'ALL' WILL NOT WORK WITH RAN TF.!!!!!*******FEB 21,73
08100	1727	CONTINUE
08200	727	NCNT(LK,LP)=10000
08300	C******** MAY 13,71 RHY REP. FEATURE OMITTED.
08400	2150	IF(MOT)MOT=-MOT
08500		IL=IL+MOT+1
08600	3150	IF(V(IL))GO TO 3723
08700		GO TO 729
08800	726	RB=V(IL+3)
08900		K=RB/10000.
09000		L=RB-K*10000
09100		IPT(LK,LP)=-(K+(L-1)*KZY)
09200		GO TO 2727
09300	3726	LK=V(IL)
09400		M=V(K+1)
09500		KL=NP(M)
09600		DO 4726 L=1,KL
09700		IPT(LK,L)=IPT(M,L)
09800		IF(IPT(M,L).NE.0)NCNT(LK,L)=10000
09900	C****** JUN 29 71  (LK,L) WAS (L,K)....???????
10000	4726	CONTINUE
10100		IPT(LK,31)=IPT(M,31)
10200		K=0
10300		GO TO 2150
10400	C   ABOVE IS FOR DUPLICATION ROUTINE   NEXT ADJUSTS TIMES FOR 'RTAP'
10500	6700	KL=IL+V(IL+1)+1.3
10600		RC=V(K-2)
10700	1770	IF(V(KL))GO TO 700
10800	2700	KL=KL+V(KL+1)+1.3
10900		GO TO 1770
11000	700	KL=KL+1
11100		IF(Z.NE.V(KL-1).OR.V(KL).NE.RC)GO TO 2700
11200		KL=KL+3
11300		KN=IL+3
11400		LN=V(KN)+.3
11500		DO 3700 L=1,LN,2
11600		RA=V(L+KN)
11700		KA=V(L+KN+1)+.3
11800		RB=0
11900		DO 4700 LP=1,KA
12000	4700	RB=RB+V(KL+LP)
12100		DO 5700 LP=1,KA
12200	5700	V(KL+LP)=V(KL+LP)/RB*RA
12300		V(KL+KA)=V(KL+KA)+.00030
12400	3700	KL=KL+KA
12500		GO TO 2150
12600	
12700	C  BELOW FOR 'TEMPO' SETUP
12800	7700	T2=V(IL+4)
12900		T1=V(IL+3)
13000		TBG=Y
13100		TDUR=V(IL+2)
13200	CC	AC=2.*TDUR/(T1+T2)
13300	CC	AC=2.*(TDUR-T1*AC)/AC**2
13400		CALL SQYY(AC,T1,T2,TDUR)
13500	8700	IF(TDUR.EQ.0)TDUR=10000.
13600		T5=1.
13700		T6=TBG+TDUR
13800		IT3=1.
13900		IF(LK.EQ.98)IT3=IL+2
14000		T4=1.
14100		GO TO 2150
14200	C*************** ANY WDCNTS DOWN FROM HERE. *********
14300	C   NEXT ADJUSTS 'MOVE' TIMES IF BG IS AT A NOTE NUMBER.
14400	1726	IF(V(IL-1).GT.-19000.)GO TO 2727
14500		RA=BT
14600		K=IL-1
14700	2726	V(K)=-9900.-RA
14800		ISUB=-1
14900		L=K+5
15000		RB=V(L)+V(L-1)
15100		V(L-1)=RA
15200		K=K+V(K+2)+2
15300		IF(V(K).GT.-19000..OR.V(K+1).NE.V(IL).OR.
15400		1 V(K).NE.-9900.-RB)GO TO 2727
15500		RA=RA+V(L)
15600		CALL BGSORT(RA)
15700		GO TO 2726
15800	C  CONVERTS BG TIME OF NOTE NUM TO REAL TIME.  DOESN'T WORK WITH -66!
15900	C   NOW WE BEGIN ON!! NOTE NUM. NOT AFTER NOTE NUM.
16000	732	DO 2606 K=NW,NWZ
16100	2606	BNW(K)=BNW(K+1)
16200		NWZ=NWZ-1
16300		IF(NWZ.EQ.0)GO TO 2111
16400		IF(NWZZ.EQ.1)GO TO 5111
16500		NWZZ=1
16600		IF(NWZ.EQ.1)GO TO 1111
16700		DO 3111 K=1,NWZ
16800		IF(BNW(K).LT.1000.)GO TO 3111
16900		X=BNW(NWZZ)
17000		BNW(NWZZ)=BNW(K)
17100		BNW(K)=X
17200		NWZZ=NWZZ+1
17300	3111	CONTINUE
17400	5111	IF(NWZZ.EQ.NWZ)GO TO 1111
17500		L=NWZZ+1
17600		X=BNW(NWZZ)
17700		DO 4111 K=L,NWZ
17800		IF(BNW(K).GT.X)GO TO 4111
17900		RA=BNW(K)
18000		BNW(K)=X
18100		X=RA
18200	4111	CONTINUE
18300		BNW(NWZZ)=X
18400		GO TO 1111
18500	111      FORMAT(1XA5,'.DAT',12X,'EDIT FILE NAME=',A5,8X,
18600		1'V ARRAY=',I4,'/2000   TEMPO FACTOR=',F6.2,4X,
18700		1'RANDOM NUMBER =',I6/)
18800	1023	FORMAT(/'  <  ',A5,'.DAT '/1XA5)
18900	C********** BELOW IS FOR 'SECTIONS'
19000	9150	FORMAT(/3X'******* SECTION ',A1)
19100	2111	NWZ=-1
19200	C  ABOVE ORDERS BNW DATA TO SAVE TIME AT 1108 ON PG5.
19300	1111	IF(MZ.EQ.0)GO TO 1601
19400	      IF(NWX.NE.1)GO TO 1486
19500	      WRITE(JOUT,111),ISLAC,IFLNM,I,TF,IXIN
19600	C*********** JUNE 1,71
19700	C********** BELOW IS FOR 'SECTIONS'
19800	1486	IF(KODE.NE.0)WRITE(JOUT,9150),KODE
19900		K=NWX-1
20000	C*********** JUNE 1,71
20100	          IF(NWX.GT.1.AND.IT(J).NE.-3)WRITE(JOUT,3154),K,Y  
20200		IF(IT(J).EQ.-3)WRITE(JOUT,5154),K,BX,INST(J) 
20300	C*********** JUNE 1,71    X 3     K'S
20400	
20500	      DO 602 K=1,NINS   
20600	48	LK=INST(K)
20700	C*********** JUNE 1,71
20800	  	IF(NCNT(K,31).NE.10000.AND.NWX.GT.1)GO TO 602
20900	CCNOV,72	IF(NCNT(K,31).NE.10000.AND.NWX.GT.1)GO TO 8826
21000		NCNT(K,31)=1
21100		IJ=IPT(K,31)
21200		X=0
21300		IF(IJ.NE.0)X=V(IJ+2)
21400	      WRITE(JOUT,5396),LK,X
21500		X=DUR(K)
21600	      IF(X.GT.10000.)GO TO 83 
21700	      WRITE(JOUT,8396),X     
21800	CCNOV,72	GO TO 8826
21900		GO TO 602
22000	5396      FORMAT(5XA5,'  RANDOM TF =',F4.2,10X,'DURATION =',$) 
22100	7396      FORMAT('+',F5.0,' NOTES')    
22200	CCNOV,72
22300	CC4396      FORMAT(5XA5,'  % RANDOM RESTS   DUR=',F7.3,'", FROM',    
22400	CC   1F6.3,' TO',F6.3)
22500	CC485      FORMAT(5XA5,'  % RANDOM RESTS = ',F4.2)     
22600	CCNOV,72
22700	8396      FORMAT('+',F6.2,'"')   
22800	83      X=X-10000.
22900	      WRITE(JOUT,7396),X    
23000	CCNOV,72 *************************************************
23100	CC8826	IF(NCNT(K,1).NE.10000)GO TO 602
23200	CC	NCNT(K,1)=1
23300	CC	IJ=IPT(K,1)+2
23400	C********* FEB 19,71
23500	CC	IF(V(IJ)-5.)GO TO 7826
23600	CC	WRITE(JOUT,4396),LK,V(IJ-1),V(IJ),V(IJ+1)
23700	C********* FEB 19,71
23800	CC	GO TO 602
23900	CC7826	WRITE(JOUT,485),LK,V(IJ)
24000	CCNOV,72 *************************************************
24100	602	CONTINUE
24200	715	IF(IT3.NE.1.)GO TO 1602
24300		RA=T1*TP
24400		RB=T2*TP
24500	      WRITE(JOUT,6154),RA,RB,TDUR  
24600	      IT3=0  
24700	1602	IF(NWX.EQ.1)GO TO 315
24800	      IF(IT(J).EQ.-3)GO TO 1108
24900	C*********** JUNE 1,71
25000	6154      FORMAT(' TMP=',F7.3,' TO',F8.3,' DURING',F6.2,' SECS.'/)
25100	7154	FORMAT(' ''CONDUCT'' FILE NAME = ',A5/)
25200	5154      FORMAT(/' << CHANGE',I3,' BEGINS ON NOTE',F5.0,1XA5,' >>'/)
25300	902      FORMAT(1XA5/)  
25400	3154      FORMAT(/' <<   BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
25500	4154      FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)  
25600	C*********** JUNE 1,71
25700		IT(J)=IT(J)/10
25800		GO TO 1108
25900	315	IF(IT3.GT.1)WRITE(JOUT,7154),ICT
26000		IF(OP1.NE.0)WRITE(JOUT,4154),OP1 
26100	1601  IF(NWX.GT.1) GO TO 1108
26300		IF(TF.GT.10.)TF=TF/60.
26400		TF=1000./TF
26500		DO 6015 K=1,30
26600	6015	COPY(K)=-9900.
26700	C  INITS PARAM REPRESSION FEATURE.
26710	      PLAY='PLAY;'
26800	      IF(KB.EQ.0)GO TO 9926   
26900	      ML=NINS+1   
27000	      NL=NINS+KB
27100	      DO 9826 K=ML,NL   
27119	      BW=OTH(K-NINS,1) 
27128		IF(BW.NE.-99)GO TO 9826
27132		PLAY=' '
27137		K=K-NINS
27146		GO TO 5741
27155	C  'INSERT -99;' COMES BEFORE 'PLAY;'
27164	9726	BW=19999.
27173		K=K+NINS
27182	9826	BG(K)=BW
27191	C   'OTH' INSERTS, WITH BG TIME IN SECONDS, CAN ONLY BE SET WITH TF=1   
27400	9926      DO 5015 K=1,NINS    
27500		IQ(K)=BG(K)*10000.
27600	      BG(K)=0
27700		INP(K)=0
27800	      P1(K)=0     
27900		IF(DUR(K).LT.10000.)DUR(K)=DUR(K)-.0001
28000	C******* FEB. 16,71   FOR ROUND-OFF NONSENSE
28100	5015      CNT(K)=0
28200		IF(MX)WRITE(1,1023)ISLAC,PLAY
28220		IF(MZ)WRITE(JOUT,1023),ISLAC,PLAY
28300	      BW=0 
28400		GO TO 500
     

00100	752      FORMAT(1X15A5)
00200	1108      M=0 
00300	      JC=0  
00400		IF(NWZ)GO TO 1740
00500	C  NWZZ IS SET AT 3111 IN SORTR.
00600		DO 740 K=1,NWZZ
00700	      X=BNW(K)    
00800		IF(X-.0001.GT.BT.OR.X.LE.BW.OR.BW)GO TO 2740
00900		IT(J)=IT(J)*10
01000	      NW=K  
01100	      GO TO 600   
01200	2740	IF(X.LT.1000..OR.X-J*10000.NE.CNT(J)+1.)GO TO 740
01300	      X=BT+PR     
01400	      NW=K  
01500		BX=CNT(J)+1.
01600	      IT(J)=-3    
01700	      GO TO 600   
01800	740      CONTINUE 
01900	      IT(J)=0     
02000	1740      IF(J.LE.NINS)GO TO 31   
02100	7021      K=J-NINS
02200	      IF(JC.GT.0)K=JC   
02300	5740      IF(PP1.LT.OP1)GO TO 1752 
02400	5741  IF(MZ)WRITE(JOUT,752),(OTH(K,L),L=2,16)    
02500	      IF(MX)WRITE(1,752)(OTH(K,L),L=2,16)     
02600	C   IF TF .NE.1, ALL  INSERT TIMES MUST BE RESET
02700	C   IF FIRST PART OF NOTE LIST IS 'OMITTED', CHECK YOUR  'INSERTS'.  
02800		DO 17521 L=3,30
02900	17521	COPY(L)=-9900.
03000	C  SO THAT ALL PARAMS WILL PRINT,AFTER AN INSERT.
03100	1752	BG(K+NINS)=19999.
03200		OTH(K,1)=19999.
03210	      IF(BW.EQ.-99)GO TO 9726
03300	      IF(JC.GT.0)GO TO 21     
03400	31      KL=1
03500	      IF(KB.EQ.0)GO TO 2031   
03600	      DO 1031 L=1,KB    
03700		K=L
03800	      X=OTH(K,1)-1000000.     
03900	      M=X/100000. 
04000	      IF(M.NE.J.OR.IQ(J).NE.0)GO TO 1031   
04100	C   M=INST  
04200	      IF(X-M*100000.EQ.CNT(J)+1)GO TO 5740 
04300	1031	CONTINUE
04400		IF(J.GT.NINS)GO TO 500
04500	2031      CNT(J)=CNT(J)+1   
04600	      ICT=CNT(J)  
04700	C   INSERT TRAP HERE FOR OVERLAP OF RESTARTED INSTS.******
04800	      NPA=NP(J)   
04900	      PP1=P1(J)  
05000	      IF(BT.GE.DUR(J))GO TO 5174    
05100		IF(IQ(J).EQ.0)GO TO 200
05200		P2=-IQ(J)/10000.
05300		IQ(J)=0
05400		CNT(J)=-1
05500		ICT=-1
05600		GO TO 4203
05700	
05800	C   MK IS FLAG FOR RESTS
05900	200	MK=0
06000	      IF((BT.EQ.0.AND.J.EQ.1).OR.IPT(J,1).EQ.0)GO TO 203    
06100		KN=IPT(J,1)-1
06200		IF(KN.GT.0)GO TO 12033
06300	12032	KN=JPT(-KN)
06400		IF(KN)GO TO 12032
06500		KN=KN-1
06600	C  FOR 'ALL' IN P32.  FOLLOWS UP ON POINTERS TO POINTERS!
06700	C   SOMEDAY PUT P1(32) IN WITH OTHER PARAMS BELOW!!!!
06800	12033	IJ=V(KN)
06900		IF(ABS(V(KN)).EQ.4.)GO TO 1203
07000	C   'IABS' IS FOR -4 USED WITH 'ALL'
07100	  	Z=(BT+9900.+V(KN-2))/V(KN+2)
07200	C******* FEB 19,71
07300		IF(Z.GT.1.)Z=1.
07400		Y=V(KN+3)
07500		X=(V(KN+4)-Y)*Z+Y
07600	C******* FEB 19,71
07700	CC******  TAKEN OUT NOV 9,72	???  IF(X.EQ.0)IPT(J,1)=0
07800		GO TO 204
07900	1203	X=V(KN+3)
08000	204	Y=RAND(0.0,1.0)
08100		IF(Y-X)MK=-1
08200	
08300	203	DF=1.
08400	C   DF=DUTY FACTOR 
08500		DO 2155 L=2,NPA
08600		ISUB=0
08700	C  WHY DOES ISUB APPEAR AT 14700/5?
08800		IDF=0 
08900	C    IDF IS DUTY FACTOR FLAG
09000		IJ=IPT(J,L)
09100	12031	IF(IJ)IJ=JPT(-IJ)
09200		IF(IJ)GO TO 12031
09300	C  FOLLOWS UP ON POINTERS TO POINTERS!
09400		PM=1.
09500		IF(IJ.GT.1)GO TO 2157
09600		P(L)=0
09700	CC	GO TO 21552
09800		GO TO 21551
09900	C 7/73
10000	2157	LN=IJ+2
10100		NM=ABS(V(IJ-1))+LN-4
10200		NL=V(IJ)
10250		IF(NL.GT.-100)GO TO 272
10300		IF(NL.GT.-200)GO TO 372
10400		ISUB=-1
10500		NL=NL+200
10600	C FOR SUBROUTINE FLAG
10700	372	IF(NL.GT.-100)GO TO 272
10800		IDF=-1
10900		NL=NL+100
11000	C  DEC.6,72  FINDS DUTY FACTOR PARAM
11100	272	VIJ2=V(IJ+1)
11200		KN=NL/(-11)
11300		IF(KN.EQ.0)GO TO 1100
11400		GO TO (61,62,62,62,65,65,67,68),KN
11500	1100	IF(VIJ2.EQ.1.)GO TO 1200
11600		ML=3
11700	1900	KA=1
11800		VX1=0
11900		DO 1156 K=LN,NM,ML
12000		VX(KA+1)=V(K)+VX(KA)
12100	1156	KA=KA+1
12200		X=RAND(0.0,1.)
12300		DO 1157 K=2,11
12400		IF(X.GT.VX(K))GO TO 1157
12500		KL=K-1
12600		IF(KN.EQ.7)GO TO 6157
12700		GO TO 1400
12800	1157	CONTINUE
12900	1400	LN=IJ+3*KL
13000	1462	RA=V(LN)
13100		IF(RA.EQ.10000.)GO TO 5174
13200	C   FOR "FINE" IN RLIST
13300		RB=V(LN+1)
13400		PAR=RAND(RA,RB)
13500	1300	IF(NL.NE.-1)PM=2.
13600	C  IF 2 THEN PRINTS A5
13700		GO TO 1155
13800	1200	PAR=V(IJ+2)
13900		GO TO 1300
14000	C   NEXT IS FOR SUBROUTINE AND QUAD CALLS
14100	61	IF(NL.LT.-12)GO TO 6100
14200	601	X=P2
14300	CC	IF(NL.EQ.-11)PL(L)=2.
14400	C  '.5' MAKES ALL SUBR PARAMS PRINTOUT.
14500		CALL SUBR
14600	C******MAY 25,71
14700	CC	IF(P(L).EQ.10000.)GO TO 5174
14800		IF(DF)GO TO 5174
14900	C  DF=-1 IN 'SUBR' WILL CAUSE 'END' FOR INST.
15000	CC	PM=PL(L)
15100		IF(L.EQ.2)GO TO 4203
15200		IF(X.EQ.P2)GO TO 21552
15300		PP2=P2
15400		PR=P2
15500		GO TO 21552
15600	C  ABOVE IS FOR P2 CHANGES IN SUBROUTINE
15700	C  TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
15800	C  ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
15900	C  BE SET TO 'REAL TIME'.)
16000	
16100	C   NEXT IS FOR QUAD ROUTINES
16200	6100	CALL QUAD(NL)
16300		GO TO 21552
16400	
16500	C   FOLLOWING IS FOR STRINGS OF VALUES.  
16600	62      KL=NCNT(J,L)+1
16700		IF(KL.GT.VIJ2)KL=1 
16800		IF(NL.NE.-46.AND.NL.NE.-36)GO TO 162
16900	C   THIS PART FOR STRINGS OF RAND SELECTION
17000		LN=KL+IJ+1
17100		KL=KL+1
17200		IF(KL.GT.VIJ2)KL=1 
17300		NL=NL+45
17400	C   FOR NUMBERS ONLY SO FAR(THIS MAKES NL=-1.  FOR NOTES, =9)
17500	162	NCNT(J,L)=KL
17600		IF(NL.GT.-22)GO TO 1462
17700	C   JUMP RAND SELECTION
17800	      PAR=V(IJ+KL+1)
17900	C********** MAY 13,71 RHY REPEAT FEATURE OMITTED.
18000	C************************
18100	CC DEC.6,72	IF(NL.EQ.-45)DF=PAR
18200		IF(KN.NE.3)GO TO 1155
18300	C*******JULY 16,71	IF(PAR.EQ.101.)GO TO 5174
18400		IF(PAR.EQ.10000.)GO TO 5174
18500		PM=2.
18600		IF(PAR.GT.100..OR.PAR.LT.1.)PM=3.
18700		IF(PAR.EQ.85.)MK=-1
18800	      GO TO 5155  
18900	65	W=-9900.-V(IJ-3)
19000	C  W=BG TIME OF MOVE.
19100		X=ABS(V(IJ-1))
19200		IF(NL.EQ.-56.OR.NL.EQ.-58)PM=2.
19300		Z=(BT-W)/VIJ2
19400	C  Z= % OF WAY THROUGH.
19500		IF(Z.GT.1.)Z=1.
19600		Y=V(LN)
19700		W=V(IJ+3)
19800		IF(X.EQ.7.)W=V(IJ+4)
19900		IF(NL.LT.-58)GO TO 16002
20000		PAR=(W-Y)*Z+Y
20100		IF(X.EQ.7.)GO TO 1600
20200		GO TO 1155
20300	C************** JUNE 1,71
20400	CC16002	PAR=(W-Y+1.)**Z-1.+Y
20500	C   FOR "MOVX"
20600	CC	IF(W-Y)PAR=(Y-W+1.)**(1.-Z)-1.+W
20700	C******** FEB/73
20800	CC16002	IF(W.EQ.0)W=W+.01
20900	C  THE .01 IS NEEDED FOR MOVE TO OR FROM 0.
21000	CC	IF(Y.EQ.0)Y=Y+.01
21100	CC	PAR=Y*((W/Y)**Z)
21200	16002	PAR=RMOVX(W,Y,Z)
21300	C  SEE FUNCTION RMOVX 6/74 -- CAN'T HAVE -20→+20, ETC., -20→-40 OK.
21400	C  THIS NEEDS WORK!
21500		IF(X.NE.7.)GO TO 1155
21600		W=V(IJ+5)
21700		Y=V(IJ+3)
21800	CC	X=(W-Y+1.)**Z-1.+Y
21900	CC	IF(W-Y)X=(Y-W+1.)**(1.-Z)-1.+W
22000	CC	IF(W.EQ.0)W=.01
22100	CC	IF(Y.EQ.0)Y=.01
22200	CC	X=Y*((W/Y)**Z)
22300		X=RMOVX(W,Y,Z)
22400		GO TO 16003
22500	C  NEXT IS FOR MOVING RAND RANGES.
22600	C1600	PAR=(V(IJ+4)-Y)*Z+Y
22700	1600	W=V(IJ+3)
22800	C*********** BACK TO 65 IS NEW.   FEB. 15,71
22900		X=(V(IJ+5)-W)*Z+W
23000	C************ JUNE 1,71   
23100	16003	PAR=RAND(PAR,X)
23200		GO TO 1155
23300	67	LN=IJ+3
23400		NM=LN+VIJ2-1
23500		ML=1
23600		GO TO 1900
23700	4155	K=(PAR-9999.0)*100.+.1	
23800		P(L)=P(K)
23900		PM=PL(K)
24000		GO TO 21551
24100	C   ANY # OVER 9999. REPEATS ANOTHER PARAM.(9999.21 REPEATS P21)
24200	6157	LN=V(LN-1)
24300		DO 1068 K=1,KL
24400	1068	IF(K.LT.KL)LN=LN+V(LN)+1
24500	2068	PM=LN+1
24600		PAR=LN+V(LN)
24700		GO TO 5155
24800	68	KL=NCNT(J,L)
24900		IF(KL.EQ.0.OR.KL.EQ.10000)KL=VIJ2
25000		PM=KL+1
25100		PAR=PM+V(KL)-1
25200		KL=PAR+1
25300		IF(V(KL).EQ.10000.)DUR(J)=BT
25400	C  'END' OR 'FINE' IN 'LIT' LIST.
25500		IF(V(KL).EQ.999.)KL=IJ+2
25600		NCNT(J,L)=KL
25700		GO TO 5155
25800	C ******* JAN 20  *************
25900	1155	IF(PAR.EQ.10000.)GO TO 5174
26000	C  TYPE 'END' AS LAST IN ANY STRING TO SET DURATION.
26100		IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
26200	C****JULY 16,71 1155	IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
26300	5155	P(L)=PAR
26400	21551	PL(L)=PM
26500		IF(ISUB)GO TO 601
26600		IF(L.EQ.2)GO TO 4203
26700	21552	IF(IDF.GE.0)GO TO 2155
26800		DF=PAR
26900		IDF=0
27000	2155	CONTINUE
27100	
27200	9203      IF(KB.EQ.0)GO TO 1170     
27300	       NL=KB
27400	      DO 2203 K=1,KB    
27500	      X=OTH(NL,1) 
27600	      IF(X.LT.100000.)GO TO 2203     
27700	      L=X/100000.
27800	      Y=(X-L*100000.)/100.    
27900	      IX=Y  
28000	      JC=NL 
28100	      IF(J.EQ.L.AND.IX.EQ.ICT)GO TO 5203    
28200	2203  NL=NL-1     
28300	      GO TO 1170  
28400	4203      PR=P2 
28500	      IF(T5.EQ.0)GO TO 7203   
28600		IF(IT3.LE.1.OR.BT.LT.TBG+TDUR)GO TO 6203
28700	3155	IT3=IT3+3
28800		TBG=TBG+TDUR
28900		TDUR=V(IT3)
29000		IF(BT.GE.TBG+TDUR)GO TO 3155
29100		T1=V(IT3+1)
29200		T2=V(IT3+2)
29300	CC	X=2.*TDUR/(T1+T2)
29400	CC	AC=2.*(TDUR-T1*X)/X**2
29500		CALL SQYY(AC,T1,T2,TDUR)
29600	6203	RA=PR 
29700		IF(BT.EQ.TBG)XT(J)=T1
29800		K=IT3
29900		RC=0  
30000		RD=1  
30100		KA=1  
30200		RB=0  
30300		Z=TDUR+TBG-BT	
30400		X=T1  
30500		Y=T2  
30600		YY=AC
30700		CHN=TBG	
30800		ZZ=TDUR	
30900		GO TO 4020  
31000	8203	P2=RA*RD    
31100	7203	P2=P2*T4
31200		X=P2*TF
31300	C  P2 IS KEPT WITHOUT TF*
31400		K=X+.5
31500		IF(X)K=X-.5
31600	72031	ROFF(J)=ROFF(J)+K-X
31700		IF(ABS(ROFF(J)).LT.1.)GO TO 7155
31800		Y=1.
31900		IF(ROFF(J))Y=-1.
32000		K=K-Y
32100		ROFF(J)=ROFF(J)-Y
32200	C  ROUND-OFF GAP WILL NOT EXCEED .001
32300	C*********** FEB 17,71
32400	7155	PP2=K/1000.
32500	C   AVOIDS ROUND-OFF PROBLEMS
32600		IF(IPT(J,31).EQ.0)GO TO 6155
32700		IF(ICT)GO TO 1170
32800		X=V(IPT(J,31)+2)/2.
32900		Y=RAND(-X,X)
33000		IF(PP2.GE.0)GO TO 615
33100		MK=-1
33200		PP2=-PP2
33300	615	PP2=PP2-RDEV(J)+Y
33400		RDEV(J)=Y
33500	C  TOTAL RAND DEV. WON'T EXCEED P31
33600	C  SET P31 TO .0001 TO BRING VOICE BACK TO EXACT TIME(0 WON'T DO IT)
33700	
33800		K=PP2*1000.+.5
33900	C****** CHECK THIS OUT  1/10/72 :::::::
34000	61551	PP2=K/1000.
34100	C   NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)
34200	6155	IF(ICT)GO TO 9203
34300		GO TO 2155
34400	5203      JD=Y*100-IX*100+.5  
34500	      IF(JD.GT.0)GO TO 3203   
34600		M=0
34700		P1(J)=PP1+PP2
34800	      GO TO 7021  
34900	3203      P(JD)=OTH(JC,2)     
35000		X=OTH(JC,3)
35100		IF(X.NE.1.)X=3.
35200	C   'EDITS' PRINT,NUM. OR 5 CHARS.
35300	      PL(JD)=X
35400	C   NEXT ADDED NOV.72  CHECK FOR SIDE AFFECTS !!!!! **********
35500		IF(JD.EQ.2)PP2=P2
35600	C   'TF' AND 'TEMPO' WILL NOT AFFECT PP2 'EDITS'.
35700	1170      IF(MK.OR.PP2)GO TO 2022   
35800	
35900		ZPAR=PP1
36000		P1(J)=PP1+PP2
36100	C   ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
36200		LK=INST(J)
36300	2021	IF(PP1.LT.OP1)GO TO 2612
36400		IF(INVIS(J).LT.0)GO TO 2170
36500	C  ALL PARAMS WILL PRINT,1ST TIME WHEN USING 'OMIT'.
36600		IF(INONLY.GT.0)GO TO 1204
36700	C*********** MAY 16,71 ↑↑↑
36800	6021	IF(P(NPA).NE.COPY(NPA).OR.PL(NPA).GT.1)GO TO 5021
36900	C******* MAY 25,71
37000	C  'LIT' DATA WILL ALWAYS PRINT.
37100		NPA=NPA-1
37200		IF(NPA.GT.2)GO TO 6021
37300	5021	DO 1304 K=3,NPA
37400	1304	COPY(K)=P(K)
37500	1204	IF(PL4.NE.1.)GO TO 2170
37600		P4=P4*AMPFAC
37700		L=0
37800		INP(J)=P4
37900		DO 1021	K=1,NINS
38000	1021	IF(P1(K).GT.PP1)L=L+INP(K)
38100		IF(L-IAMP-1)GO TO 2170
38200		IAMP=L
38300		AMPTIM=PP1
38400	2170	IF(MX.EQ.3)GO TO 2612
38500	C ********* MAY 17,71
38600	      PP1=PP1-OP1     
38700	C   PUTS SPACES BETWEEN NOTES .GT. .05( APART
38800		IF((MZ.NE.-1).OR.(A.GE.PP1))GO TO 5170
38900		IF(INONLY)WRITE(JOUT,902)
39000		A=PP1+.05
39100	5170	ML=10
39200		IF(NPA.LT.10)ML=NPA
39300		MLX=3
39400		NL=2
39500		IF(INVIS(J).EQ.0)GO TO 3170
39600	CC5170	IF(INVIS(J).EQ.0)GO TO 3170
39700	CC	MLX=3
39800		LK=0
39900	C  NEEDED TO INIT INVISIBLE MODE PRINT-OUT (NO INST NAME, P1, P2)
40000	C  NEXT CREATES FORMAT DATA IN IFM ARRAY.
40100	31701	KL=3
40200		GO TO 4170
40300	3170	IF(.NOT.INONLY.AND.J.NE.INONLY)GO TO 2612
40400		VX(1)=PP1
40410		IF(DF.GT.0)GO TO 6170
40418		VX2=-DF
40426		IF(VX2.GT.PP2)VX2=PP2
40434	C NEG. DF=FIXED NOTE DUR. NOT.GT.PP2   7/74 COLGATE  -AND BELOW
40442		GO TO 7170
40450	6170	IF(DF.LT.100)GO TO 8170
40458	C DF>100 = FIXED REST AREA BEFORE NEXT ATTACK.
40466		VX2=PP2-DF+100.
40474		IF(VX2.LE.0)VX2=PP2/2.
40482	C NO NEG. TIME VALUES ALLOWED.
40490		GO TO 7170
40500	8170	VX2=PP2*DF
40600	7170	IFM3='F9.3,'
40700		IFM4=IFM3
40800		KL=5
40900	CC	ML=10
41000	CC	IF(NPA.LT.10)ML=NPA
41100	CC	MLX=3
41200	CC	NL=2
41300		IF(NPA.LT.3)GO TO 2121
41400	
41500	4170	NL=2
41600		DO 1121 K=MLX,ML
41700		X=P(K)
41800		L=PL(K)
41900		IF(L-2)321,521,621
42000	321	IF(X.GE.0)GO TO 4211
42100		IFM(KL)=IFCOM
42200		NL=NL+1
42300		KL=KL+1
42400	4211	IFM(KL)='F9.3,'
42500	C   CREATES 'F9.3'
42600	421	VX(KL-NL)=X
42700		GO TO 1121
42800	521	IFM(KL)=IFM2
42900	C   CREATES '1XA5'
43000		LN=X
43100		VX(KL-NL)=SCAL(LN)
43200		GO TO 42
43300	621	IF(L.GT.3)GO TO 721
43400		VX(KL-NL)=X
43500	C ABOVE LETS A5 WD BE USED IN SUBR BY SETTING PL(N)=3.
43600	42	IFM(KL)=IFM2
43700		GO TO 1121
43800	721	LN=X
43900		IFM(KL)=I1X
44000		NL=NL+1
44100		DO 821 M=1,LN-L+1
44200		KL=KL+1
44300		IOUT(KL-NL)=IV(L-1+M)
44400	821	IFM(KL)=IA1
44500	1121	KL=KL+1
44600	
44700	C  NO MORE THAN 80 ITEMS IN FORMAT.
44800	2121	IF(KL.LE.80)GO TO 21211
44900	21212	FORMAT(' ERROR! TOO MANY LIT. ITEMS')
45000		TYPE 21212
45100	21211	DO 921 M=KL+1,80
45200	921 	IFM(M)=IBLA
45300		IFM(KL)=')'
45400		L=KL-NL-1
45500		IF(MX)WRITE(1,IFM)LK,(VX(K),K=1,L)
45600		IF(.NOT.MZ)GO TO 30210
45700		IF(ML.GE.NPA)IFM(KL)='$)'
45800		WRITE(JOUT,IFM),LK,(VX(K),K=1,L)
45900	30210	IF(ML.GE.NPA)GO TO 3021
46000		MLX=ML+1
46100		ML=ML+10
46200		IF(ML.GT.NPA)ML=NPA
46300		LK=IBLA
46400		GO TO 31701
46500	3021	IF(MX)WRITE(1,3616)INST(J),ICT
46600	30211	IF(MZ)WRITE(JOUT,8902),J,INST(J),ICT,BT
46700	2612      PP1=ZPAR     
46800	         GO TO 21 
46900	8902	FORMAT('+;<'I2,1XA5,I4,' >',F7.3)
47000	3616	FORMAT(';PRINT(P1);< ',A5,I4)
47100	C   PRINTS RESTS  
47200	2022	PP2=ABS(PP2)
47300	C   IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT P2. 
47400	C   FOR RESTS IN SEQS. TYPE -DUR.   
47500	C   WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
47600	C    RAN RESTS ARE NOT TOUCHED BY SUBROUTINES!!!
47700		INP(J)=0
47800		P1(J)=PP1+PP2
47900	C   STORES NEXT P1 TIME FOR THIS INST.
48000		IF((MZ.NE.-1).OR.(PP1.LT.OP1))GO TO 21   
48100	      X=PP1-OP1  
48200		IF(A.GE.X)GO TO 121
48300		WRITE(JOUT,902)
48400		A=X+.05
48500	121	IF(INONLY.OR.J.EQ.INONLY)WRITE(JOUT,1110),INST(J),X,PP2,
48600		1 J,INST(J),ICT
48700	21	PR=ABS(PR)
48800	      BG(J)=BT+PR 
48900	      IF(ICT.EQ.DUR(J)-10000.)GO TO 5174 
49000	      IF(BG(J).LT.DUR(J))GO TO 500  
49100	5174      BG(J)=19999. 
49200	      DO 3174 K=1,NINS  
49300	C   INSERTS CANT FOLLOW LAST REGULAR NOTE.
49400	C   (ADD REST IF INSERT AT END IS NEEDED.)    
49500	3174      IF(BG(K).LT.19999.)GO TO 500     
49600	      GO TO 175   
49700	C   CHOOSES INST WITH NEXT BEGIN TIME.    
49800	500      J=1   
49900		BW=BT
50000	      NL=NINS+KB
50100	      DO 22 K=2,NL
50200	22      IF(BG(J).GT.BG(K))J=K 
50300		IF(J.GT.NINS.OR.NINS.EQ.1)GO TO 3022
50400		J=1
50500		DO 5022 K=2,NINS
50600		X=P1(J)
50700		Y=P1(K)+.0001
50800	C  LOWEST NUMBERED INST WILL COME 1ST IF BG TIMES ARE VERY CLOSE
50900		IF(BG(J).EQ.19999.)X=19999.
51000		IF(BG(K).EQ.19999.)Y=19999.
51100	5022	IF(X.GT.Y)J=K
51200	C   ABOVE IS FOR ROUND-OFF PROBLEMS WITH 'TEMPO' AND 'CONDUCT'.
51300	3022      BT=BG(J)    
51400	      IF((BT.EQ.19999.).OR.(P1(J).GE.DURX))GO TO 175
51500		IF(CNT(J).GT.0)GO TO 1022
51600	      IF(CNT(J).EQ.0)P1(J)=0  
51700	      IF(CNT(J).EQ.-1)CNT(J)=0
51800	C   N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0   
51900	1022      IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 1108    
52000	      T4=T2 
52100	      T5=0  
52200	      T6=10000.   
52300	      GO TO 1108    
52400	1175	FORMAT('+',A5,'=',F7.3,2X,$)
52500	1109	FORMAT(' FINISH; < ',A5,'.DAT')
52600	1110	FORMAT(' <',A5,2F9.3,2X,'******* REST <'I2,1XA5,I4)
52700	1603	FORMAT(' AMPL. FACTOR=',F4.2,', MAX.AMP.=',I4,', AT TIME',
52800		1 F8.3)
52900	175	IF(MZ)WRITE(JOUT,1109),ISLAC
53000	CC	IF(MX.GE.0)GO TO 603
53100		IF(MX.GE.0)GO TO 4175
53200		WRITE(1,1109),ISLAC
53300		END FILE 1
53400	603	FORMAT(' TOTAL DURS:  ',$)
53500	CC	IF(MZ)GO TO 4175
53600	CC	TYPE 1603,AMPFAC,IAMP,AMPTIM
53700	CC	TYPE 603
53800	CC	GO TO 5175
53900	4175	WRITE(JOUT,1603),AMPFAC,IAMP,AMPTIM
54000		WRITE(JOUT,603)
54100	5175	DO 2175 K=1,NINS
54200		X=P1(K)-OP1
54300		IF(MZ)GO TO 6175
54400		TYPE 1175,INST(K),X
54500		GO TO 2175
54600	6175	WRITE(JOUT,1175),INST(K),X
54700	2175	CONTINUE
54800		IF(JOUT.NE.22)GO TO 3175
54900		END FILE 22
55000		CALL PRINT
55100		REWIND 22
55200		K='FOR22'
55300		CALL OFILE(22,K)
55400	C   LEAVES FOR22.DAT WITH 0K
55500		END FILE 22
55600	3175	TYPE 1023,ISLAC
55700		END
55800	
55900		FUNCTION RMOVX(W,Y,Z)
56000		IF(W.EQ.0)W=.01
56100		IF(Y.EQ.0)Y=.01
56200		RMOVX=Y*((W/Y)**Z)
56300		END